packages feed

webdriver-w3c (empty) → 0.0.1

raw patch · 30 files changed

+9635/−0 lines, 30 filesdep +JuicyPixelsdep +QuickCheckdep +SHAsetup-changed

Dependencies added: JuicyPixels, QuickCheck, SHA, aeson, aeson-pretty, base, base64-bytestring, bytestring, containers, directory, exceptions, http-client, http-types, lens, lens-aeson, network-uri, parsec, random, scientific, script-monad, stm, tasty, tasty-expected-failure, tasty-hunit, tasty-quickcheck, text, time, unordered-containers, uri-encode, vector, webdriver-w3c, wreq

Files

+ ChangeLog.md view
@@ -0,0 +1,12 @@+# Changelog for webdriver-w3c++## Unreleased changes++(none)++## 0.0.1++* New+    * `WebDriver` monad for remotely controlling user agents. Also comes in monad transformer flavor with `WebDriverT` +    * Bindings for all [WebDriver endpoints](https://w3c.github.io/webdriver/webdriver-spec.html) as of 2018-04-20+    * Integration with the [Tasty](https://hackage.haskell.org/package/tasty) test framework
+ LICENSE view
@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ README.md view
@@ -0,0 +1,57 @@+webdriver-w3c+=============++[![Build Status](https://travis-ci.org/nbloomf/webdriver-w3c.svg?branch=master)](https://travis-ci.org/nbloomf/webdriver-w3c)++Haskell bindings for the W3C WebDriver API+++What is it?+-----------++`webdriver-w3c` is a Haskell library providing bindings to the WebDriver API, enabling us to write Haskell programs that control web browsers. It is actively tested against `geckodriver` and `chromedriver`, as well as a fake remote end implementation. It is implemented as a monad transformer.++Also included is an integration with the [tasty](https://hackage.haskell.org/package/tasty) test framework.++[WebDriver](https://www.w3.org/TR/webdriver/) is an HTTP API for interacting with a web browser remotely. It is on track to become a W3C specification and based on work done by the [Selenium](https://www.seleniumhq.org/) community.+++Who is it for?+--------------++If you:++* Are interested in browser automation, especially for testing,+* Want to write browser automation code in Haskell, and+* Don't mind filing bug and feature requests,++then you might give `webdriver-w3c` a try.++This library is unrelated to [webdriver](http://hackage.haskell.org/package/webdriver) except in spirit. That library is older and more mature, and depending on your needs may be more appropriate.+++Where is the documentation?+---------------------------++Depends on what you want!++* _A cursory glance:_ This brief [tutorial](https://github.com/nbloomf/webdriver-w3c/blob/master/doc/Tutorial.md) shows how to go from nothing to one very simple test.+* _To start a simple project:_ If you want to write a test suite, there's a separate tutorial on using the [tasty integration](https://github.com/nbloomf/webdriver-w3c/blob/master/doc/TastyDemo.md).+* _To dig into the API:_ The API docs will eventually be on Hackage.+* _To mess with the library code:_ There's a very small amount of [developer documentation](https://github.com/nbloomf/webdriver-w3c/blob/master/dev/doc.md); I'm also happy to answer questions.+++Who is responsible for this?+----------------------------++Nathan Bloomfield (@nbloomf) wrote and maintains the code.++Other contributors, in lexicographic order:++* Ivan Enderlin (@hywan)++And users like you!++Also thanks to my employer for allowing -- actually, requiring :) -- this to be open source.++And special thanks to Jonathan Lipps' [Simplified Guide](https://github.com/jlipps/simple-wd-spec) to the WebDriver spec.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.lhs view
@@ -0,0 +1,394 @@+Getting Started with `webdriver-w3c`+------------------------------------++Hello, and welcome to the wonderful world of browser automation with WebDriver and Haskell! This module is a brief tutorial on how we can use use the `webdriver-w3c` library to write Haskell programs that interact with web pages just like a person would. If you need to test a web application, or want to automate some web thing that curl and wget alone can't handle easily, you might find this mildly interesting, maybe.++(This text is a literate program, so we have to start with some compiler noises. Nothing to see here!)++> {-# LANGUAGE OverloadedStrings #-}+> module Main where+> +> import Web.Api.WebDriver+> import Test.Tasty.WebDriver+> +> import Test.Tasty+> import qualified System.Environment as SE+> import Control.Monad+> +> main :: IO ()+> main = return ()++++Prerequisites+-------------++To follow along, you're going to need a few things.++1. [Stack](https://docs.haskellstack.org/en/stable/README/). Stack is a build tool for Haskell projects. It compiles our programs, runs tests, processes documentation, generates code coverage reports, and keeps project dependencies under control.+2. A copy of this repository+3. A web browser; this tutorial assumes you're using Firefox.+4. A WebDriver proxy server for your browser. For Firefox this is [geckodriver](https://github.com/mozilla/geckodriver). Don't sweat it if you don't know what "WebDriver proxy server" means right now, we'll get to that.++Next, start your proxy server. For geckodriver on unix-like OSs, that is done with the `geckodriver &` command. You should see a line that looks something like this:++    1521524046173	geckodriver	INFO	Listening on 127.0.0.1:4444++Leave that program running. Just leave it alone.++Finally, in another shell window, navigate to the directory holding this repo and say++    stack ghci webdriver-w3c:webdriver-w3c-intro++Well, don't *say* that, out loud. Type it. :) This might take a while the first time while stack downloads the compiler and libraries it needs. When it finishes, this command opens a Haskell interpreter with `webdriver-w3c` loaded so we can play with it. You'll know everything is okay if you see a line like++    Ok, one module loaded.++followed by a `λ:` prompt. To be sure, try typing in `return` and then hit (enter). If you see this scary error message:++    <interactive>:1:1: error:+        • No instance for (Show (a0 -> m0 a0))+            arising from a use of ‘print’+            (maybe you haven't applied a function to enough arguments?)+        • In a stmt of an interactive GHCi command: print it++then everything is working great!++++My First Browser Automation+---------------------------++Ok! You've got your WebDriver proxy (geckodriver) running in one terminal window, and ghci running in another. Let's start with a simple example to illustrate what we can do, then explain how it works. Read this code block, even if the syntax is meaningless.++> do_a_barrel_roll :: WebDriver IO ()+> do_a_barrel_roll = do+>   fullscreenWindow+>   navigateTo "https://www.google.com"+>   performActions [typeString "do a barrel roll"]+>   performActions [press EnterKey]+>   wait 5000000+>   return ()++Without running that code -- and maybe without being proficient in Haskell -- what do you think it does?++Now let's run it. In the interpreter, type++    example1++followed by (enter). You should see a Firefox window open, go fullscreen, and search Google for "do a barrel roll".++`example1`, by the way, is this:++> example1 :: IO ()+> example1 = do+>   execWebDriver defaultWebDriverConfig+>     (runIsolated defaultFirefoxCapabilities do_a_barrel_roll)+>   return ()++Let's break down what just happened.++1. `do_a_barrel_roll` is a *WebDriver session*, expressed in the `WebDriver` DSL. It's a high-level description for a sequence of browser actions: in this case, "make the window full screen", "navigate to google.com", and so on.+2. `runIsolated` takes a WebDriver session and runs it in a fresh browser instance. The parameters of this instance are specified in `defaultFirefoxCapabilities`.+3. `execWebDriver` takes a WebDriver session and carries out the steps, using some options specified in `defaultWebDriverConfig`.++You probably also noticed a bunch of noise got printed to your terminal starting with something like this:++    λ: example1+    2018-06-23 15:19:46 Request POST http://localhost:4444/session+    {+        "capabilities": {+            "alwaysMatch": {+                "browserName": "firefox"+            }+        },+        "desiredCapabilities": {+            "browserName": "firefox"+        }+    }+    2018-06-23 15:19:48 Response+    {+        "value": {+            "sessionId": "383edca7-3054-0544-8c1e-cc64099462de",+            "capabilities": {+                "moz:webdriverClick": true,+                "platformVersion": "17.4.0",+                "moz:headless": false,+                "moz:useNonSpecCompliantPointerOrigin": false,+                "browserVersion": "60.0.2",+                "rotatable": false,+                "pageLoadStrategy": "normal",+                "moz:profile": "/var/folders/td/sxyy9wl919740vddr49g8nth0000gn/T/rust_mozprofile.aleh5JscOwwI",+                "moz:accessibilityChecks": false,+                "moz:processID": 88470,+                "platformName": "darwin",+                "timeouts": {+                    "implicit": 0,+                    "script": 30000,+                    "pageLoad": 300000+                },+                "acceptInsecureCerts": false,+                "browserName": "firefox"+            }+        }+    }++This is the log. WebDriver sessions keep track of a bunch of info to help with debugging, like all requests and responses and all raised errors. By default the logs are printed to stderr but this is configurable.++So what can you do in a WebDriver session? Not much -- but this is by design. The library includes:++* A binding for each endpoint in the WebDriver spec+* Some basic functions for reading and writing files, reading and writing at the console, and making arbitrary HTTP requests++This plus Haskell's `do` notation make for a tidy EDSL for running browsers. Notably, a `WebDriver` session cannot do arbitrary `IO` by default, and `WebDriver` sessions are pure values. (There is an escape hatch for this restriction.)++++Behind the Scenes+-----------------++WebDriver is an HTTP API for controlling web browsers like a human user would. In principle a browser could implement this API directly. In practice the major browsers have their own internally maintained APIs for automation and use a *proxy server* to translate between WebDriver and their internal API.++This is the role geckodriver is playing in our examples so far: deep down, our code is making HTTP requests to geckodriver, and geckodriver is passing these requests on to Firefox.++This library is also tested against Chrome via chromedriver. To do that, using `chromedriver`'s default settings, we need to make a couple of adjustments to the examples: replace++    defaultWebDriverConfig++by++    defaultWebDriverConfig+      { _env = defaultWDEnv+        { _remotePort = 9515+        , _responseFormat = ChromeFormat+        }+      }++and replace++    defaultFirefoxCapabilities++by++    defaultChromeCapabilities++(By the way - `defaultWebDriverConfig` has type `WebDriverConfig`, and includes knobs for tweaking almost everything about how our sessions run.)++++Making Assertions+-----------------++It's expected that you're probably interested in using browser automation to run end-to-end tests on some web application -- and `webdriver-w3c` has some extra bits built in to make this simpler.++In addition to the usual browser action commands, you can sprinkle your `WebDriver` sessions with *assertions*. Here's an example.++> what_page_is_this :: (Monad eff) => WebDriver eff ()+> what_page_is_this = do+>   navigateTo "https://www.google.com"+>   title <- getTitle+>   assertEqual title "Welcome to Lycos!" "Making sure we're at the lycos homepage"+>   return ()++Note the signature: `(Monad eff) => WebDriver eff ()` instead of `WebDriver IO ()`. What's happening here is that `WebDriver` is parameterized by the monad that effects (like writing to files and making HTTP requests) take place in. These effects are "run" by an explicit evaluator that, for the default configuration, happens to use `IO`, but both the effect monad and the evaluator are configurable. By swapping out `IO` for another type we can, for example, run our tests against a mock Internet, and swapping out the evaluator we might have a "dry run" evaluator that doesn't actually do anything, but logs what it would have done. It's good practice to make our `WebDriver` code maximally flexible by using an effect parameter like `eff` instead of the concrete `IO` unless there's a good reason not to.++Anyway, back to the example. What do you think this code does? Let's try it: type++    example2++in the interpreter. You should see a browser window open briefly to google.com, with a scary "Invalid Assertion" message in the interpreter. `assertEqual` is the assertion statement: it takes two things (strings in this case) and checks whether they are equal. Shocking, hm? The third argument to `assertEqual` is a *comment*, so we can include some human readable info as to *why* this assertion was made.++This is `example2`:++> example2 :: IO ()+> example2 = do+>   (_, result) <- debugWebDriver defaultWebDriverConfig+>     (runIsolated defaultFirefoxCapabilities what_page_is_this)+>   printSummary result+>   return ()++Here's what happened:++1. `what_page_is_this` is a WebDriver session, just like `do_a_barrel_roll`, this time including an assertion: that the title of some web page is "Welcome to Lycos!".+2. `runIsolated` runs `what_page_is_this` in a fresh browser instance.+3. `debugWebDriver` works much like `execWebDriver`, except that it collects the results of any assertion statements and summarizes them (this is `result`).+4. `printSummary` takes the assertion results and prints them out all pretty like.++So what kinds of assertions can be made? The best place to learn about these is in the generated Haddock documentation.++++Suites of Tests+---------------++Alright. If you're writing e2e tests, you probably want to write a *lot* of e2e tests. In this case, we'd like our tests to be modular, isolated, and well-organized, so that when things go wrong we can quickly diagnose what happened. For this, `webdriver-w3c` integrates with the [tasty](https://hackage.haskell.org/package/tasty) test framework -- just import `Test.Tasty.WebDriver`.++Suppose we've got two WebDriver tests. These are pretty dweeby just for illustration's sake.++> back_button :: (Monad eff) => WebDriver eff ()+> back_button = do+>   navigateTo "https://www.google.com"+>   navigateTo "https://wordpress.com"+>   goBack+>   title <- getTitle+>   assertEqual title "Google" "Behavior of 'back' button from WordPress homepage"+>   return ()+> +> refresh_page :: (Monad eff) => WebDriver eff ()+> refresh_page = do+>   navigateTo "https://www.mozilla.org"+>   pageRefresh+>   title <- getTitle+>   assertEqual title "Mozilla's Epic HomePage on the Internets"+>     "Refresh mozilla.org"+>   return ()++We can organize them into a hierarchy of tests like so.++> test_suite :: TestTree+> test_suite = testGroup "All Tests"+>   [ testCase "Back Button" back_button+>   , testCase "Refresh" refresh_page+>   ]++Try running the suite with++    example3++in the interpreter. Here's what `example3` looks like:++> example3 :: IO ()+> example3 = do+>   SE.setEnv "TASTY_NUM_THREADS" "1"+>   defaultWebDriverMain+>     $ localOption (SilentLog)+>     $ test_suite++Here's what happened:++1. `test_suite` is a Tasty tree of individual `WebDriver` test cases.+2. `defaultWebDriverMain` is a Tasty function that runs test trees. In this case we've also used `localOption` to tweak how the tests run -- suppressing the usual session log output.++Tasty gave us lots of nice things for free, like pretty printing test results and timings.++    λ: example3+    >>> Deployment environment is DEV+    >>> Logging with colors+    All Tests+      Back Button: OK (7.23s)+        1 assertion(s)+      Refresh:     FAIL (4.29s)+        Invalid Assertion +        assertion: "Internet for people, not profit \8212 Mozilla" is equal to "Mozilla's Epic HomePage on the Internets" +        comment: Refresh mozilla.org++    1 out of 2 tests failed (11.53s)++Other test case constructors and test options are available. For now the best place to see what's possible is the haddock documentation for `Test.Tasty.WebDriver`.++The test suite for `webdriver-w3c` itself uses the Tasty integration. There is also a function, `checkWebDriver`, that can be used to build tests with QuickCheck, if you don't find that idea abominable. :)++++We need more power!+-------------------++The vanilla `WebDriver` is designed to help you control a browser with _batteries included_, but it has limitations. It can't possibly anticipate all the different ways you might want to control your tests, and it can't do arbitrary `IO`. But we have a powerful and very general escape hatch: `WebDriver` is a special case of the `WebDriverT` monad transformer. ++The actual definition of `WebDriver` is++    type WebDriver eff a = WebDriverT (IdentityT eff) a++where `IdentityT` is the _inner monad_ in transformer terms -- actually it's an inner monad transformer, on the effect monad `eff`. By swapping out `IdentityT` for another transformer we can add features specific to our application.++Here's a typical example. Say you're testing a site with two deployment tiers -- "test" and "production". For the most part the same test suite should run against both tiers, but there are minor differences. Say the base URLs are slightly different; maybe production lives at `example.com` while test lives at `test.example.com`. Also while developing a new feature some parts of the test suite should only run on the test tier, maybe controlled by a feature flag.++What we need is some extra read-only state to pass around. We can do this with a `ReaderT` transformer. To avoid adding a dependency on a whole transformer library, lets roll our own:++> data ReaderT r eff a = ReaderT+>   { runReaderT :: r -> eff a+>   }+> +> instance (Monad eff) => Monad (ReaderT r eff) where+>   return x = ReaderT $ \_ -> return x+> +>   x >>= f = ReaderT $ \r -> do+>     a <- runReaderT x r+>     runReaderT (f a) r+> +> instance (Monad eff) => Applicative (ReaderT r eff) where+>   pure = return+>   (<*>) = ap+> +> instance (Monad eff) => Functor (ReaderT r eff) where+>   fmap f x = x >>= (return . f)+> +> liftReaderT :: (Monad eff) => eff a -> ReaderT r eff a+> liftReaderT x = ReaderT $ \_ -> x+> +> reader :: (Monad eff) => (r -> a) -> ReaderT r eff a+> reader f = ReaderT $ \r -> return $ f r++Now our actual state might look something like this:++> data MyEnv = MyEnv+>   { tier :: Tier+>   , featureFlag :: Bool+>   }+> +> data Tier = Test | Production+> +> env :: Tier -> MyEnv+> env t = MyEnv+>   { tier = t+>   , featureFlag = False+>   }++And we can augment `WebDriverT` with our reader transformer.++> type MyWebDriver eff a = WebDriverT (ReaderT MyEnv eff) a++Now we can build values in `MyWebDriver` using the same API as before, using the extra features of the inner monad with `liftWebDriverT`.++> custom_environment :: (Monad eff) => MyWebDriver eff ()+> custom_environment = do+>   theTier <- liftWebDriverT $ reader tier+>   case theTier of+>     Test -> navigateTo "http://google.com"+>     Production -> navigateTo "http://yahoo.com"++To actually run sessions using our custom monad stack we need to make a few adjustments. First, we use `execWebDriverT` instead of `execWebDriver`. This function takes one extra argument corresponding to `lift` for the inner transformer.++Second, we need to supply a function that "runs" the inner transformer (in this case `ReaderT eff a`) to `IO`.++> execReaderT :: r -> ReaderT r IO a -> IO a+> execReaderT r x = runReaderT x r++Running our custom WebDriver monad is then straightforward.++> example4 :: Tier -> IO ()+> example4 t = do+>   execReaderT (env t) $+>     execWebDriverT defaultWebDriverConfig liftReaderT+>       (runIsolated defaultFirefoxCapabilities custom_environment)+>   return ()++Try it out with++    example4 Test+    example4 Production++We can similarly use a custom inner monad to check assertions and with the tasty integration; there are analogous `debugWebDriverT` and `testCaseT` functions.++`ReaderT` is just one option for the inner monad transformer. We could put mutable state, delimited continuations, or even another HTTP API monad in there. Use your imagination!++++Where to Learn More+-------------------++The canonical source is the generated haddock documentation. Until this is uploaded to hackage, the only way to get the docs is to run++    stack haddock++in this directory and point your browser to the local URL that command emits under "Updating Haddock index for local packages and dependencies in..."
+ app/ParallelStressTest.hs view
@@ -0,0 +1,39 @@+{-+This program is meant to simulate running a large number of tests in parallel. To set the number of tests to be run, export the WD_STRESS_TEST_NUM_TESTS variable in the shell.+-}++module Main where++import Test.Tasty+import Test.Tasty.WebDriver++import Web.Api.WebDriver++import System.Exit (exitFailure)+import System.Environment (lookupEnv)+import Text.Read (readMaybe)++_test :: (Monad eff) => WebDriver eff ()+_test = navigateTo "https://google.com"+++main :: IO ()+main = do+  var <- lookupEnv "WD_STRESS_TEST_NUM_TESTS"++  k <- case var >>= readMaybe of+    Nothing -> showError+    Just m -> if m <= 0+      then showError+      else return m ++  defaultWebDriverMain $+    localOption (SilentLog) $+    testGroup "Test Demo" $+      [ testCase ("navigate to google.com #" ++ show i) _test | i <- [1..k] ]+++showError :: IO a+showError = do+  putStrLn "WD_STRESS_TEST_NUM_TESTS must be a positive integer."+  exitFailure
+ app/TastyDemo.lhs view
@@ -0,0 +1,147 @@+Using `webdriver-w3c` with `tasty`+==================================++It's possible to run "raw" WebDriver sessions, but it's much more convenient to use the [tasty](https://hackage.haskell.org/package/tasty) integration. With tasty we can incorporate WebDriver tests alongside, say, quickcheck and HUnit tests, and get test reports, stats, filtering, and parallel execution for free.++This module demonstrates how to set up a basic test executable and configure it with command line options.++> {-# LANGUAGE OverloadedStrings #-}+> module Main where++We'll need some imports. These are the usual `tasty` modules:++> import Test.Tasty+> import Test.Tasty.ExpectedFailure++These are the `webdriver-w3c` modules:++> import Web.Api.WebDriver++And this is the module that integrates the two.++> import Test.Tasty.WebDriver+++Define your tests+-----------------++First things first: to make a WebDriver test suite, we need some WebDriver tests. These are just values of type `WebDriver IO ()`. (Or more generally, `Effectful m => WebDriver m ()`, but that's not important for now.) Here are a few dweeby examples. It's not necessary for the tests to start with `_test` or use snake_case; I'm doing it here out of habit.++> _test_one :: (Monad eff) => WebDriver eff ()+> _test_one = do+>   navigateTo "https://google.com"+> +> _test_two :: (Monad eff) => WebDriver eff ()+> _test_two = do+>   navigateTo "https://yahoo.com"+>   assertSuccess "time travel achieved"+++Define your `main`+------------------++As usual, our program starts with `main`.++The simplest way to make a test executable with tasty is to use `defaultWebDriverMain`, which has the following signature:++    defaultWebDriverMain :: TestTree -> IO ()++This function wraps tasty's `defaultMain`, which handles command line option parsing, and adds some magic of its own. `TestTree` is tasty's type for an executable test suite. There are three functions for building these out of WebDriver sessions.++1. `testCase`, which defines a simple named test consisting of a single WebDriver session+2. `testGroup`, which defines a named list of `TestTree`s+3. `testCaseWithSetup`, which is like `testCase` but takes additional setup and teardown instructions to be run before and after the test; `testCaseWithSetup` is less frequently useful, but it's there just in case.++Here's an example `main`.++> main :: IO ()+> main = defaultWebDriverMain $+>   testGroup "Test Demo"+>     [ testCase "navigate to google.com" _test_one+>     , testCase "check status" _test_two+>     , ifDriverIs Chromedriver ignoreTest $+>         testCase "navigate to google.com" _test_one+>     ]++We can run different sets of tests based on the value of an option using `askOption`, and we can change the value of an option locally using `localOption`. Changing one option based on the value of another option is a common task; for example, some tests should run differently in headless mode.++Several common uses of the `askOption` pattern are defined in `Test.Tasty.WebDriver`; for instance, the helper function `ifDriverIs` lets us adjust options for different drivers, and `ifTierIs` lets us change behavior between development and testing deployments.+++Start your remotes+------------------++To actually run our test suite, we need to have at least one _remote end_ running. These are the proxy servers that accept WebDriver requests via http and reach into a browser to make it do stuff. For now, the library has only been tested with geckodriver and chromedriver. Make sure you've got one or both of those installed, then kick off an instance of each one.++For example,+```+geckodriver > /dev/null 2> /dev/null &+```+starts a geckodriver instance in the background (but suppresses its otherwise voluminous debug output).++You'll want to take note of which host and port your remote end is listening on. By default, geckodriver listens on localhost, port 4444, and chromedriver listens on 9515.+++Run your tests+--------------++This demo executable is named `wd-tasty-demo`. If you install and run it, you'll get an error message:++    Error: no remotes defined for geckodriver++What does this mean? To run a webdriver session, we have to tell our program the URIs of the remote ends it should use -- it does not assume one. There are two ways to do this, and you can use either one (or both).++`--wd-remote-ends` lets us supply the remote end URIs on the command line directly. Suppose I've got geckodriver listening on port 4444 and chromedriver on port 9515 (which they do by default). Then I'd use the following option:++    --wd-remote-ends 'geckodriver: https://localhost:4444 chromedriver: https://localhost:9515'++(Note the explicit `https` scheme; this is required.) This is fine if you have a small number of remote ends running, but the command line quickly gets unwieldy if you have tens or hundreds of remote ends ready to run tests in parallel. So we can also specify the remote end URIs in a specially formatted config file. The config file must look something like this:++    geckodriver+    - https://localhost:4444+    - https://localhost:4445+    chromedriver+    - https://localhost:9515+    - https://localhost:9516++The drivers can come in any order and don't have to be contiguous, and blank lines are ignored. Suppose this file is called `~/.wd/config`; then we supply this to our test executable with the following option:++    --wd-remote-ends-config ~/.wd/config++`webdriver-w3c` can also run your tests in parallel. To take advantage of this, you'll need to compile your executable with `-threaded -rtsopts -with-rtsopts=-N` and start it with the `--num-threads N` option. You'll also need to start more than one remote end of each type. Note that if you want to run N tests in parallel, then you'll need N instances of _each_ remote end (geckodriver and chromedriver) running in the background. This is because the tests are _processed_ sequentially, even if they run in parallel. For instance, if you have 100 firefox tests followed by 100 chrome tests, but run them with one geckodriver and one chromedriver, the tests will run sequentially.++There are a bunch of other command line options for tweaking the behavior of your webdriver tests; use `wd-tasty-demo --help` to see a list. Most of these are pretty specialized. Other options are pretty common. In addition to `--wd-remote-ends` and `--wd-remote-ends-config`, there's `--wd-driver`, for specifying which driver to use, and `--wd-response-format`, which is required when using chromedriver because chromedriver is not fully spec compliant.+++Example sessions+----------------++Here are some example commands for running this demo.++Run one at a time with geckodriver:++```+geckodriver --port 4444 > /dev/null 2> /dev/null &+wd-tasty-demo --wd-remote-ends 'geckodriver: https://localhost:4444'+```++Run one at a time with geckodriver, but can it with all the logs:++```+geckodriver --port 4444 > /dev/null 2> /dev/null &+wd-tasty-demo --wd-remote-ends 'geckodriver: https://localhost:4444' --wd-verbosity silent+```++Run one at a time with chromedriver:++```+chromedriver --port=9515 &+wd-tasty-demo --wd-driver chromedriver --wd-response-format chromedriver --wd-remote-ends 'chromedriver: https://localhost:9515'+```++Run two at a time with geckodriver:++```+geckodriver --port 4444 > /dev/null 2> /dev/null &+wd-tasty-demo --wd-remote-ends 'geckodriver: https://localhost:4444' --num-threads 2+```
+ src/Test/Tasty/WebDriver.hs view
@@ -0,0 +1,932 @@+{- |+Module      : Test.Tasty.WebDriver+Description : WebDriver integration with the Tasty test framework.+Copyright   : 2018, Automattic, Inc.+License     : GPL-3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX++Tasty integration for `WebDriverT` tests.+-}++{-# LANGUAGE DeriveDataTypeable, RecordWildCards, Rank2Types #-}+module Test.Tasty.WebDriver (+    defaultWebDriverMain++  -- * Test Case Constructors+  , testCase+  , testCaseM+  , testCaseT+  , testCaseTM+  , testCaseWithSetup+  , testCaseWithSetupM+  , testCaseWithSetupT+  , testCaseWithSetupTM++  -- * Branching+  , ifDriverIs+  , ifTierIs+  , ifHeadless+  , unlessDriverIs+  , unlessTierIs+  , unlessHeadless++  -- * Options+  , Driver(..)+  , DriverName(..)+  , DataPath(..)+  , Deployment(..)+  , DeploymentTier(..)+  , BrowserPath(..)+  , ApiResponseFormat(..)+  , WebDriverApiVersion(..)+  , LogHandle(..)+  , TestDelay(..)+  , NumRetries(..)+  , LogNoiseLevel(..)+  , ConsoleInHandle(..)+  , ConsoleOutHandle(..)+  , RemoteEndRef(..)+  , Headless(..)+  , LogColors(..)+  , GeckodriverLog(..)++  , module Test.Tasty.WebDriver.Config+  ) where++++import Control.Monad.IO.Class+  ( MonadIO, liftIO )+import Data.Typeable+  ( Typeable, Proxy(Proxy) )+import Data.List+  ( unlines, lookup )+import System.IO+  ( Handle, stdout, stderr, stdin, openFile, IOMode(..), hClose )+import Control.Concurrent+  ( threadDelay )+import Control.Concurrent.MVar+  ( MVar, newMVar, withMVar )+import Control.Concurrent.STM+  +import Control.Lens+  ((.~), (&))+import qualified Data.ByteString.Lazy.Char8 as BS+  ( pack )+import qualified Data.Digest.Pure.SHA as SHA+  ( showDigest, sha1 )+import Data.IORef+  ( IORef, newIORef, atomicModifyIORef' )+import Data.Maybe+  ( fromMaybe )+import Data.Time.Clock.System+  ( getSystemTime )+import Network.HTTP.Client+  ( defaultManagerSettings, managerResponseTimeout, ResponseTimeout(..)+  , responseTimeoutNone )+import qualified Network.Wreq as Wreq+  ( defaults, manager )+import qualified System.Environment as SE+  ( getEnv, setEnv, getArgs, lookupEnv )+import System.Exit+  ( exitFailure )+import Text.Read+  ( readMaybe )++import qualified Data.Map.Strict as MS+import qualified Test.Tasty as T+import qualified Test.Tasty.Providers as TT+import qualified Test.Tasty.Options as TO+import qualified Test.Tasty.ExpectedFailure as TE+import qualified Test.Tasty.Ingredients.ConsoleReporter as TC++import Control.Monad.Script.Http (trivialLogOptions)+import Web.Api.WebDriver+import Test.Tasty.WebDriver.Config++++_OPT_LOG_HANDLE :: String+_OPT_LOG_HANDLE = "wd-log"++_OPT_CONSOLE_OUT :: String+_OPT_CONSOLE_OUT = "wd-console-out"++_OPT_CONSOLE_IN :: String+_OPT_CONSOLE_IN = "wd-console-in"++_OPT_COLOR :: String+_OPT_COLOR = "wd-color"++_OPT_HEADLESS :: String+_OPT_HEADLESS = "wd-headless"++_OPT_DRIVER :: String+_OPT_DRIVER = "wd-driver"++_OPT_GECKODRIVER_LOG :: String+_OPT_GECKODRIVER_LOG = "wd-geckodriver-log"++_OPT_BROWSERPATH :: String+_OPT_BROWSERPATH = "wd-browserpath"++_OPT_DEPLOYMENT :: String+_OPT_DEPLOYMENT = "wd-deploy"++_OPT_REMOTE_ENDS :: String+_OPT_REMOTE_ENDS = "wd-remote-ends"++_OPT_DATA_PATH :: String+_OPT_DATA_PATH = "wd-data-path"++_OPT_RESPONSE_FORMAT :: String+_OPT_RESPONSE_FORMAT = "wd-response-format"++_OPT_API_VERSION :: String+_OPT_API_VERSION = "wd-api-version"++_OPT_VERBOSITY :: String+_OPT_VERBOSITY = "wd-verbosity"++_OPT_NUM_RETRIES :: String+_OPT_NUM_RETRIES = "wd-num-retries"++_OPT_DELAY :: String+_OPT_DELAY = "wd-delay"++_OPT_REMOTE_ENDS_CONFIG :: String+_OPT_REMOTE_ENDS_CONFIG = "wd-remote-ends-config"++++data WebDriverTest m eff = WebDriverTest+  { wdTestName :: String+  , wdTestSession :: WebDriverT (m eff) ()+  , wdEval :: forall a. P WDAct a -> eff a+  , wdLift :: forall a. eff a -> m eff a+  , wdToIO :: forall a. m eff a -> IO a+  }++++instance (Monad eff, Monad (m eff), Typeable eff, Typeable m) => TT.IsTest (WebDriverTest m eff) where+  testOptions = return+    [ TO.Option (Proxy :: Proxy Driver)+    , TO.Option (Proxy :: Proxy Headless)+    , TO.Option (Proxy :: Proxy ApiResponseFormat)+    , TO.Option (Proxy :: Proxy WebDriverApiVersion)+    , TO.Option (Proxy :: Proxy LogHandle)+    , TO.Option (Proxy :: Proxy LogNoiseLevel)+    , TO.Option (Proxy :: Proxy ConsoleInHandle)+    , TO.Option (Proxy :: Proxy ConsoleOutHandle)+    , TO.Option (Proxy :: Proxy Deployment)+    , TO.Option (Proxy :: Proxy DataPath)+    , TO.Option (Proxy :: Proxy BrowserPath)+    , TO.Option (Proxy :: Proxy TestDelay)+    , TO.Option (Proxy :: Proxy RemoteEndRef)+    , TO.Option (Proxy :: Proxy RemoteEndOpt)+    , TO.Option (Proxy :: Proxy NumRetries)+    , TO.Option (Proxy :: Proxy LogColors)+    , TO.Option (Proxy :: Proxy GeckodriverLog)+    ]++  run opts WebDriverTest{..} _ = do+    let+      Driver driver = TO.lookupOption opts+      Headless headless = TO.lookupOption opts+      ApiResponseFormat format = TO.lookupOption opts+      WebDriverApiVersion version = TO.lookupOption opts+      LogHandle logHandle = TO.lookupOption opts+      logNoiseLevel = TO.lookupOption opts+      ConsoleInHandle cinHandle = TO.lookupOption opts+      TestDelay delay = TO.lookupOption opts+      ConsoleOutHandle coutHandle = TO.lookupOption opts+      DataPath datas = TO.lookupOption opts+      BrowserPath browserPath = TO.lookupOption opts+      RemoteEndRef remotes = TO.lookupOption opts+      NumRetries numRetries = TO.lookupOption opts+      LogPrinterLock (Just logLock) = TO.lookupOption opts+      LogColors logColors = TO.lookupOption opts+      GeckodriverLog geckoLogLevel = TO.lookupOption opts++    let+      title = comment wdTestName++      attemptLabel k = comment $ "Attempt #" ++ show k++      logNoise = case logNoiseLevel of+        NoisyLog -> False+        SilentLog -> True++      caps = case driver of+        Geckodriver -> emptyCapabilities+          { _browserName = Just Firefox+          , _firefoxOptions = Just defaultFirefoxOptions+              { _firefoxBinary = browserPath+              , _firefoxArgs = if headless then Just ["-headless"] else Nothing+              , _firefoxLog = Just FirefoxLog+                  { _firefoxLogLevel = Just geckoLogLevel+                  }+              }+          }++        Chromedriver -> emptyCapabilities+          { _browserName = Just Chrome+          , _chromeOptions = Just $ defaultChromeOptions+              { _chromeBinary = browserPath+              , _chromeArgs = if headless then Just ["--headless"] else Nothing+              }+          }++    dataPath <- case datas of+      Nothing -> fmap (++ "/.webdriver") $ SE.getEnv "HOME"+      Just dpath -> return dpath++    remotesRef <- case remotes of+      Just ref -> return ref+      Nothing -> do+        putStrLn "Error: no remote ends specified."+        exitFailure++    let+      attempt :: Int -> IO TT.Result+      attempt attemptNumber = do++        remote <- acquireRemoteEnd remotesRef delay driver++        let+          uid = digest wdTestName ++ "-" ++ show attemptNumber ++ " " ++ show remote+            where+              digest :: (Show a) => a -> String+              digest = take 8 . SHA.showDigest . SHA.sha1 . BS.pack . show++          config = WDConfig+            { _evaluator = wdEval+            , _initialState = S+              { _httpOptions = Wreq.defaults+                  & Wreq.manager .~ Left (defaultManagerSettings +                    { managerResponseTimeout = responseTimeoutNone } )+              , _httpSession = Nothing+              , _userState = WDState+                { _sessionId = Nothing+                }+              }+            , _environment = defaultWebDriverEnvironment+              { _logHandle = logHandle+              , _logLock = Just logLock+              , _uid = uid+              , _logOptions = defaultWebDriverLogOptions+                { _logColor = logColors+                , _logJson = True+                , _logHeaders = False+                , _logSilent = logNoise+                }+              , _env = WDEnv+                { _remoteHostname = remoteEndHost remote+                , _remotePort = remoteEndPort remote+                , _remotePath = remoteEndPath remote+                , _responseFormat = format+                , _apiVersion = version+                , _dataPath = dataPath+                , _stdout = coutHandle+                , _stdin = cinHandle+                }+              }+            }++        (result, summary) <- wdToIO $ debugWebDriverT config wdLift $+            title >> attemptLabel attemptNumber >> runIsolated caps wdTestSession++        atomically $ releaseRemoteEnd remotesRef driver remote++        case result of+          Right _ ->+            return $ webDriverAssertionsToResult summary+          Left err -> if attemptNumber >= numRetries+            then return $ TT.testFailed $ "Unhandled error!\n" ++ err+            else attempt (attemptNumber + 1)++    attempt 1++++webDriverAssertionsToResult :: AssertionSummary -> TT.Result+webDriverAssertionsToResult x =+  if numFailures x > 0+    then TT.testFailed $ unlines $ map printAssertion $ failures x+    else TT.testPassed $ show (numSuccesses x) ++ " assertion(s)"++++-- | `WebDriver` test case with the default `IO` effect evaluator.+testCase+  :: TT.TestName+  -> WebDriver IO () -- ^ The test+  -> TT.TestTree+testCase name test =+  testCaseWithSetup name (return ()) return (const test)+++-- | `WebDriver` test case with a custom effect evaluator.+testCaseM+  :: (Monad eff, Typeable eff)+  => TT.TestName+  -> (forall a. P WDAct a -> eff a) -- ^ Evaluator+  -> (forall a. eff a -> IO a) -- ^ Conversion to `IO`+  -> WebDriver eff ()+  -> TT.TestTree+testCaseM name eval toIO test =+  testCaseWithSetupM name eval toIO (return ()) return (const test)+++-- | `WebDriverT` test case with the default `IO` effect evaluator.+testCaseT+  :: (Monad (m IO), Typeable m)+  => TT.TestName+  -> (forall a. IO a -> m IO a) -- ^ Lift effects to the inner monad+  -> (forall a. m IO a -> IO a) -- ^ Conversion to `IO`+  -> WebDriverT (m IO) () -- ^ The test+  -> TT.TestTree+testCaseT name lift toIO test =+  testCaseWithSetupT name lift toIO (return ()) return (const test)+++-- | `WebDriverT` test case with a custom effect evaluator.+testCaseTM+  :: (Monad eff, Monad (m eff), Typeable eff, Typeable m)+  => TT.TestName+  -> (forall a. P WDAct a -> eff a) -- ^ Evaluator+  -> (forall a. eff a -> m eff a) -- ^ Lift effects to the inner monad+  -> (forall a. m eff a -> IO a) -- ^ Conversion to `IO`.+  -> WebDriverT (m eff) () -- ^ The test+  -> TT.TestTree+testCaseTM name eval lift toIO test =+  testCaseWithSetupTM name eval lift toIO (return ()) return (const test)+++-- | `WebDriver` test case with additional setup and teardown phases using the default `IO` effect evaluator. Setup runs before the test (for e.g. logging in) and teardown runs after the test (for e.g. deleting temp files).+testCaseWithSetup+  :: TT.TestName+  -> WebDriver IO u -- ^ Setup+  -> (v -> WebDriver IO ()) -- ^ Teardown+  -> (u -> WebDriver IO v) -- ^ The test+  -> TT.TestTree+testCaseWithSetup name =+  testCaseWithSetupM name (evalIO evalWDAct) id+++-- | `WebDriver` test case with additional setup and teardown phases and a custom effect evaluator. Setup runs before the test (for e.g. logging in) and teardown runs after the test (for e.g. deleting temp files).+testCaseWithSetupM+  :: (Monad eff, Typeable eff)+  => TT.TestName+  -> (forall u. P WDAct u -> eff u) -- ^ Evaluator+  -> (forall u. eff u -> IO u) -- ^ Conversion to `IO`+  -> WebDriver eff u -- ^ Setup+  -> (v -> WebDriver eff ()) -- ^ Teardown+  -> (u -> WebDriver eff v) -- ^ The test+  -> TT.TestTree+testCaseWithSetupM name eval toIO =+  testCaseWithSetupTM name eval IdentityT (toIO . runIdentityT)+++-- | `WebDriverT` test case with additional setup and teardown phases using the default `IO` effect evaluator. Setup runs before the test (for e.g. logging in) and teardown runs after the test (for e.g. deleting temp files).+testCaseWithSetupT+  :: (Monad (m IO), Typeable m)+  => TT.TestName+  -> (forall a. IO a -> m IO a) -- ^ Lift effects to the inner monad+  -> (forall a. m IO a -> IO a) -- ^ Conversion to `IO`+  -> WebDriverT (m IO) u -- ^ Setup+  -> (v -> WebDriverT (m IO) ()) -- ^ Teardown+  -> (u -> WebDriverT (m IO) v) -- ^ Test+  -> TT.TestTree+testCaseWithSetupT name =+  testCaseWithSetupTM name (evalIO evalWDAct)+++-- | `WebDriverT` test case with additional setup and teardown phases and a custom effect evaluator. Setup runs before the test (for logging in, say) and teardown runs after the test (for deleting temp files, say). +testCaseWithSetupTM+  :: (Monad eff, Monad (m eff), Typeable eff, Typeable m)+  => TT.TestName+  -> (forall a. P WDAct a -> eff a) -- ^ Evaluator+  -> (forall a. eff a -> m eff a) -- ^ Lift effects to the inner monad+  -> (forall a. m eff a -> IO a) -- ^ Conversion to `IO`.+  -> WebDriverT (m eff) u -- ^ Setup+  -> (v -> WebDriverT (m eff) ()) -- ^ Teardown+  -> (u -> WebDriverT (m eff) v) -- ^ Test+  -> TT.TestTree+testCaseWithSetupTM name eval lift toIO setup teardown test =+  TT.singleTest name WebDriverTest+    { wdTestName = name+    , wdTestSession = setup >>= test >>= teardown+    , wdEval = eval+    , wdLift = lift+    , wdToIO = toIO+    }++++-- | Remote end name.+newtype Driver+  = Driver { theDriver :: DriverName }+  deriving Typeable++instance TO.IsOption Driver where+  defaultValue = Driver Geckodriver+  parseValue str = case str of+    "geckodriver" -> Just $ Driver Geckodriver+    "chromedriver" -> Just $ Driver Chromedriver+    _ -> Nothing+  optionName = return _OPT_DRIVER+  optionHelp = return "remote end name: (geckodriver), chromedriver"++++-- | Governs whether logs are printed in color+newtype LogColors+  = LogColors { theLogColors :: Bool }+  deriving Typeable++instance TO.IsOption LogColors where+  defaultValue = LogColors True+  parseValue = fmap LogColors . TO.safeReadBool+  optionName = return _OPT_COLOR+  optionHelp = return "colored logs: (true), false"++++-- | Run in headless mode.+newtype Headless+  = Headless { theHeadless :: Bool }+  deriving Typeable++instance TO.IsOption Headless where+  defaultValue = Headless False+  parseValue = fmap Headless . TO.safeReadBool+  optionName = return _OPT_HEADLESS+  optionHelp = return "run in headless mode: (false), true"++++-- | Path where secrets are stored.+newtype DataPath+  = DataPath { theDataPath :: Maybe FilePath }+  deriving Typeable++instance TO.IsOption DataPath where+  defaultValue = DataPath Nothing+  parseValue path = Just $ DataPath $ Just path+  optionName = return _OPT_DATA_PATH+  optionHelp = return "data path: (~/.webdriver), PATH"++++-- | Verbosity level passed to @geckodriver@+newtype GeckodriverLog+  = GeckodriverLog { theGeckodriverLog :: LogLevel }+  deriving Typeable++instance TO.IsOption GeckodriverLog where+  defaultValue = GeckodriverLog LogInfo+  parseValue level = case level of+    "trace" -> Just $ GeckodriverLog LogTrace+    "debug" -> Just $ GeckodriverLog LogDebug+    "config" -> Just $ GeckodriverLog LogConfig+    "info" -> Just $ GeckodriverLog LogInfo+    "warn" -> Just $ GeckodriverLog LogWarn+    "error" -> Just $ GeckodriverLog LogError+    "fatal" -> Just $ GeckodriverLog LogFatal+    _ -> Nothing+  optionName = return _OPT_GECKODRIVER_LOG+  optionHelp = return "log level passed to geckodriver: trace, debug, config, info, warn, error, fatal"++++-- | Path to browser binary.+newtype BrowserPath+  = BrowserPath { theBrowserPath :: Maybe FilePath }+  deriving Typeable++instance TO.IsOption BrowserPath where+  defaultValue = BrowserPath Nothing+  parseValue path = Just $ BrowserPath $ Just path+  optionName = return _OPT_BROWSERPATH+  optionHelp = return "path to browser binary: (), PATH"++++-- | Expected API response format.+newtype ApiResponseFormat+  = ApiResponseFormat { theApiResponseFormat :: ResponseFormat }+  deriving Typeable++instance TO.IsOption ApiResponseFormat where+  defaultValue = ApiResponseFormat SpecFormat+  parseValue str = case str of+    "spec" -> Just $ ApiResponseFormat SpecFormat+    "chromedriver" -> Just $ ApiResponseFormat ChromeFormat+    _ -> Nothing+  optionName = return _OPT_RESPONSE_FORMAT+  optionHelp = return "JSON response format: (spec), chromedriver"++++-- | WebDriver API version.+newtype WebDriverApiVersion+  = WebDriverApiVersion { theWebDriverApiVersion :: ApiVersion }+  deriving Typeable++instance TO.IsOption WebDriverApiVersion where+  defaultValue = WebDriverApiVersion CR_2018_03_04+  parseValue str = case str of+    "cr-2018-03-04" -> Just $ WebDriverApiVersion CR_2018_03_04+    _ -> Nothing+  optionName = return _OPT_API_VERSION+  optionHelp = return "WebDriver API version: (cr-2018-03-04)"++++-- | Log location.+newtype LogHandle+  = LogHandle { theLogHandle :: Handle }+  deriving Typeable++instance TO.IsOption LogHandle where+  defaultValue = LogHandle stderr+  parseValue _ = Just $ LogHandle stderr+  optionName = return _OPT_LOG_HANDLE+  optionHelp = return "log destination: (stderr), stdout, PATH"++++newtype LogPrinterLock = LogPrinterLock+  { theLogPrinterLock :: Maybe (MVar ())+  } deriving Typeable++instance TO.IsOption LogPrinterLock where+  defaultValue = LogPrinterLock Nothing+  parseValue = error "LogPrinterLock is an internal option."+  optionName = error "LogPrinterLock is an internal option."+  optionHelp = error "LogPrinterLock is an internal option."++++-- | Log Noise Level.+data LogNoiseLevel+  = NoisyLog+  | SilentLog+  deriving Typeable++instance TO.IsOption LogNoiseLevel where+  defaultValue = NoisyLog+  parseValue str = case str of+    "noisy" -> Just NoisyLog+    "silent" -> Just SilentLog+    _ -> Nothing+  optionName = return _OPT_VERBOSITY+  optionHelp = return "log verbosity: (noisy), silent"++++-- | Max number of retries.+newtype NumRetries+  = NumRetries { theNumRetries :: Int }+  deriving Typeable++instance TO.IsOption NumRetries where+  defaultValue = NumRetries 1+  parseValue = fmap NumRetries . readMaybe+  optionName = return _OPT_NUM_RETRIES+  optionHelp = return "number of times to retry a failed test"++++-- | Console in location. Used to mock stdin for testing.+newtype ConsoleInHandle+  = ConsoleInHandle { theConsoleInHandle :: Handle }+  deriving Typeable++instance TO.IsOption ConsoleInHandle where+  defaultValue = ConsoleInHandle stdin+  parseValue _ = Just $ ConsoleInHandle stdin+  optionName = return _OPT_CONSOLE_IN+  optionHelp = return "console input: (stdin), PATH"++++-- | Console out location. Used to mock stdout for testing.+newtype ConsoleOutHandle+  = ConsoleOutHandle { theConsoleOutHandle :: Handle }+  deriving Typeable++instance TO.IsOption ConsoleOutHandle where+  defaultValue = ConsoleOutHandle stdout+  parseValue _ = Just $ ConsoleOutHandle stdout+  optionName = return _OPT_CONSOLE_OUT+  optionHelp = return "console output: (stdout), stderr, PATH"++++-- | Delay between test attempts.+newtype TestDelay = TestDelay+  { theTestDelay :: Int+  } deriving (Eq, Show, Typeable)++instance TO.IsOption TestDelay where+  defaultValue = TestDelay 800000+  parseValue = fmap TestDelay . readMaybe+  optionName = return _OPT_DELAY+  optionHelp = return "delay between test attempts in ms: (500000), INT"++++-- | Named deployment environment.+newtype Deployment+  = Deployment { theDeployment :: DeploymentTier }+  deriving (Eq, Typeable)++-- | Representation of the deployment environment.+data DeploymentTier+  = DEV -- ^ Local environment+  | TEST -- ^ CI server (for testing the library)+  | PROD -- ^ "Production" -- e.g. testing a real site+  deriving (Eq, Show, Typeable)++instance TO.IsOption Deployment where+  defaultValue = Deployment DEV+  parseValue str = case str of+    "dev" -> Just $ Deployment DEV+    "test" -> Just $ Deployment TEST+    "prod" -> Just $ Deployment PROD+    _ -> Nothing+  optionName = return _OPT_DEPLOYMENT+  optionHelp = return "deployment environment: (dev), test, prod"++++-- | Mutable remote end pool+newtype RemoteEndRef = RemoteEndRef+  { theRemoteEndRef :: Maybe (TVar RemoteEndPool)+  } deriving (Typeable)++instance TO.IsOption RemoteEndRef where+  defaultValue = RemoteEndRef Nothing+  parseValue _ = Just $ RemoteEndRef Nothing+  optionName = return _OPT_REMOTE_ENDS_CONFIG+  optionHelp = return "path to remote end config"++++data RemoteEndOpt = RemoteEndOpt+  deriving Typeable++instance TO.IsOption RemoteEndOpt where+  defaultValue = RemoteEndOpt+  parseValue _ = Just RemoteEndOpt+  optionName = return _OPT_REMOTE_ENDS+  optionHelp = return "remote end uris"++++-- | Set local options if the @Driver@ option is a given value.+ifDriverIs :: DriverName -> (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree+ifDriverIs driver f tree = T.askOption checkDriver+  where+    checkDriver :: Driver -> TT.TestTree+    checkDriver (Driver d) = if d == driver+      then f tree+      else tree++-- | Set local options if the @Driver@ option is not a given value.+unlessDriverIs :: DriverName -> (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree+unlessDriverIs driver f tree = T.askOption checkDriver+  where+    checkDriver :: Driver -> TT.TestTree+    checkDriver (Driver d) = if d /= driver+      then f tree+      else tree++++-- | Set local options if the @Deployment@ option is a given value.+ifTierIs :: DeploymentTier -> (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree+ifTierIs tier f tree = T.askOption checkDeployment+  where+    checkDeployment :: Deployment -> TT.TestTree+    checkDeployment (Deployment t) = if t == tier+      then f tree+      else tree++-- | Set local options if the @Deployment@ option is not a given value.+unlessTierIs :: DeploymentTier -> (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree+unlessTierIs tier f tree = T.askOption checkDeployment+  where+    checkDeployment :: Deployment -> TT.TestTree+    checkDeployment (Deployment t) = if t /= tier+      then f tree+      else tree++++-- | Set local options if `Headless` is true.+ifHeadless :: (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree+ifHeadless f tree = T.askOption checkHeadless+  where+    checkHeadless :: Headless -> TT.TestTree+    checkHeadless (Headless p) = (if p then f else id) tree++-- | Set local options if `Headless` is false.+unlessHeadless :: (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree+unlessHeadless f tree = T.askOption checkHeadless+  where+    checkHeadless :: Headless -> TT.TestTree+    checkHeadless (Headless p) = (if p then id else f) tree++++-- | Run a tree of webdriver tests. Thin wrapper around tasty's @defaultMain@ that attempts to determine the deployment tier and interprets remote end config command line options.+defaultWebDriverMain :: TT.TestTree -> IO ()+defaultWebDriverMain tree = do+  logLock <- newMVar ()+  pool <- getRemoteEndRef++  -- Determine the deployment tier+  deploy <- getEnvVarDefaultOption+    _OPT_DEPLOYMENT (`lookup` [("dev", DEV), ("test", TEST), ("prod", PROD)])+    "CI" (\str -> Just $ if str == "true" then TEST else DEV)+    DEV+  putStrLn $ ">>> Deployment environment is " ++ show deploy++  -- Determine color output preferences+  colors <- getEnvVarDefaultOption+    _OPT_COLOR (`lookup` [("true", True), ("false", False)])+    "NO_COLOR" (\_ -> Just False)+    True+  putStrLn $ ">>> Logging " ++ (if colors then "with" else "without") ++ " colors"++  if colors+    then return ()+    else SE.setEnv "TASTY_COLOR" "never"++  logHandle <- getWriteModeHandleOption _OPT_LOG_HANDLE stderr+  coutHandle <- getWriteModeHandleOption _OPT_CONSOLE_OUT stdout+  cinHandle <- getReadModeHandleOption _OPT_CONSOLE_IN stdin++  T.defaultMain+    . T.localOption (Deployment deploy)+    . T.localOption (RemoteEndRef $ Just pool)+    . T.localOption (LogPrinterLock $ Just logLock)+    . T.localOption (LogHandle logHandle)+    . T.localOption (LogColors colors)+    . T.localOption (ConsoleOutHandle coutHandle)+    . T.localOption (ConsoleInHandle cinHandle)+    $ tree++  mapM_ hClose+    [ logHandle, coutHandle, cinHandle ]+++getWriteModeHandleOption :: String -> Handle -> IO Handle+getWriteModeHandleOption opt theDefault = do+  args <- SE.getArgs+  case parseOptionWithArgument ("--" ++ opt) args of+    Nothing -> do+      putStrLn $ "Error: option '" ++ opt ++ "' is missing a required path argument"+      exitFailure+    Just Nothing -> return theDefault+    Just (Just path) -> case path of+      "stdout" -> return stdout+      "stderr" -> return stderr+      _ -> openFile path WriteMode+++getReadModeHandleOption :: String -> Handle -> IO Handle+getReadModeHandleOption opt theDefault = do+  args <- SE.getArgs+  case parseOptionWithArgument ("--" ++ opt) args of+    Nothing -> do+      putStrLn $ "Error: option '" ++ opt ++ "' is missing a required path argument"+      exitFailure+    Just Nothing -> return theDefault+    Just (Just path) -> case path of+      "stdin" -> return stdin+      _ -> openFile path ReadMode+++-- | Get the value of an option that can be controlled by either a command line flag or an environment variable, with the flag taking precedence.+getEnvVarDefaultOption+  :: String -- ^ Flag name+  -> (String -> Maybe a) -- ^ Mapping flag values to option values+  -> String -- ^ Environment variable name+  -> (String -> Maybe a) -- ^ Mapping environment variable values to option values+  -> a -- ^ Default option value (if neither flag nor env var is set)+  -> IO a+getEnvVarDefaultOption flag flagMap var varMap def = do+  args <- SE.getArgs+  case parseOptionWithArgument ("--" ++ flag) args of++    -- Flag is present, but with no argument given.+    Nothing -> do+      putStrLn $ "Error: option '" ++ flag ++ "' is missing a required argument"+      exitFailure++    -- Flag with argument is present.+    Just (Just value) ->+      case flagMap value of+        Just a -> return a+        Nothing -> do+          putStrLn $ "Error: unrecognized value '" ++ value ++ "' for option '--" ++ flag ++ "'."+          exitFailure++    -- Flag not present; try to use the environment variable.+    Just Nothing -> do+      value <- SE.lookupEnv var+      case value of++        -- Environment variable is set.+        Just str ->+          case varMap str of+            Just a -> return a+            Nothing -> do+              putStrLn $ "Error: unrecognized value '" ++ str +++                "' for environment variable '" ++ var ++ "'."+              exitFailure++        -- Environment variable not set; use default.+        Nothing -> return def++++getRemoteEndRef :: IO (TVar RemoteEndPool)+getRemoteEndRef = do+  configPool <- fromMaybe mempty <$> getRemoteEndConfigPath+  optionPool <- fromMaybe mempty <$> getRemoteEndOptionString+  let pool = mappend configPool optionPool+  if pool == mempty+    then newTVarIO $ RemoteEndPool $ MS.fromList+      [ (Geckodriver, [RemoteEnd "localhost" 4444 ""])+      , (Chromedriver, [RemoteEnd "localhost" 9515 ""])+      ]+    else newTVarIO $ mappend configPool optionPool++++getRemoteEndConfigPath :: IO (Maybe RemoteEndPool)+getRemoteEndConfigPath = do+  args <- SE.getArgs+  case parseOptionWithArgument "--wd-remote-ends-config" args of+    Nothing -> do+      putStrLn "option --wd-remote-ends-config missing required path argument"+      exitFailure+    Just Nothing -> return Nothing+    Just (Just path) -> do+      str <- readFile path+      case parseRemoteEndConfig str of+        Left err -> do+          putStrLn err+          exitFailure+        Right x -> return (Just x)++++getRemoteEndOptionString :: IO (Maybe RemoteEndPool)+getRemoteEndOptionString = do+  args <- SE.getArgs+  case parseOptionWithArgument "--wd-remote-ends" args of+    Nothing -> do+      putStrLn "option --wd-remote-ends missing required argument"+      exitFailure+    Just Nothing -> return Nothing+    Just (Just str) ->+      case parseRemoteEndOption str of+        Left err -> do+          putStrLn err+          exitFailure+        Right x -> return (Just x)++++acquireRemoteEnd :: TVar RemoteEndPool -> Int -> DriverName -> IO RemoteEnd+acquireRemoteEnd var delay driver = do+  result <- atomically $ acquireRemoteEndSTM var driver+  case result of+    Nothing -> do+      putStrLn $ "Error: no remotes defined for " ++ show driver+      exitFailure+    Just Nothing -> do+      threadDelay delay+      acquireRemoteEnd var delay driver+    Just (Just x) -> return x++acquireRemoteEndSTM+  :: TVar RemoteEndPool -> DriverName -> STM (Maybe (Maybe RemoteEnd))+acquireRemoteEndSTM var driver = do+  pool <- readTVar var+  let (newPool, result) = getRemoteEndForDriver driver pool+  writeTVar var newPool+  return result++releaseRemoteEnd :: TVar RemoteEndPool -> DriverName -> RemoteEnd -> STM ()+releaseRemoteEnd var driver remote =+  modifyTVar' var $ addRemoteEndForDriver driver remote
+ src/Test/Tasty/WebDriver/Config.hs view
@@ -0,0 +1,179 @@+{- |+Module      : Test.Tasty.WebDriver.Config+Description : Helpers for parsing config files.+Copyright   : 2018, Automattic, Inc.+License     : GPL-3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX+-}++{-# LANGUAGE RecordWildCards #-}+module Test.Tasty.WebDriver.Config (+    DriverName(..)+  , RemoteEndPool(..)+  , addRemoteEndForDriver+  , getRemoteEndForDriver+  , RemoteEnd(..)++  -- * Parsing+  , parseRemoteEnd+  , parseRemoteEndConfig+  , parseRemoteEndOption++  , parseOptionWithArgument+  ) where++import Data.List+  ( unlines, isPrefixOf, isSuffixOf, nub )+import qualified Data.Map.Strict as MS+  ( fromListWith, insert, lookup, adjust, fromList, unionWith, Map )+import Data.Typeable+  ( Typeable, Proxy(Proxy) )+import Network.URI+  ( URI(..), URIAuth(..), parseURI )+import Text.Read+  ( readMaybe )++++-- | Remote end name.+data DriverName+  = Geckodriver+  | Chromedriver+  deriving (Eq, Ord, Typeable)++instance Show DriverName where+  show Geckodriver = "geckodriver"+  show Chromedriver = "chromedriver"++-- | Pool of remote end connections per driver.+newtype RemoteEndPool = RemoteEndPool+  { freeRemoteEnds :: MS.Map DriverName [RemoteEnd]+  } deriving (Eq, Show)++instance Monoid RemoteEndPool where+  mempty = RemoteEndPool+    { freeRemoteEnds = MS.fromList []+    }++  mappend x y = RemoteEndPool+    { freeRemoteEnds = MS.unionWith (++) (freeRemoteEnds x) (freeRemoteEnds y)+    }++-- | Push a remote end to the pool stack for a given driver.+addRemoteEndForDriver :: DriverName -> RemoteEnd -> RemoteEndPool -> RemoteEndPool+addRemoteEndForDriver driver remote pool = RemoteEndPool+  { freeRemoteEnds = MS.adjust (remote:) driver $ freeRemoteEnds pool+  }++-- | Attempt to pop a remote end from the pool stack for a given driver. Returns the new pool, whether or not a remote end was popped. Returns a `Just Just` if a remote end was found, a `Just Nothing` if the driver has an empty stack of remotes, and `Nothing` if the pool is undefined for the driver.+getRemoteEndForDriver :: DriverName -> RemoteEndPool -> (RemoteEndPool, Maybe (Maybe RemoteEnd))+getRemoteEndForDriver driver pool =+  case MS.lookup driver (freeRemoteEnds pool) of+    Nothing -> (pool, Nothing)+    Just z -> case z of+      [] -> (pool, Just Nothing)+      (r:rs) -> (pool { freeRemoteEnds = MS.insert driver rs $ freeRemoteEnds pool }, Just $ Just r)++-- | Representation of a remote end connection.+data RemoteEnd = RemoteEnd+  { remoteEndHost :: String -- ^ Scheme, auth, and hostname+  , remoteEndPort :: Int+  , remoteEndPath :: String -- ^ Additional path component+  } deriving Eq++instance Show RemoteEnd where+  show remote = concat+    [ remoteEndHost remote+    , ":"+    , show $ remoteEndPort remote+    , remoteEndPath remote+    ]++-- | Parse a remote end config file. This file consists of 0 or more blocks of the form+--+-- > DRIVER_NAME+-- > - REMOTE_END_URI+-- > - REMOTE_END_URI+--+-- where `DRIVER_NAME` is either `geckodriver` or `chromedriver` and each `REMOTE_END_URI` is the uri of a WebDriver remote end, including scheme. Blank lines are ignored.+parseRemoteEndConfig :: String -> Either String RemoteEndPool+parseRemoteEndConfig str = do+  freeEnds <- fmap (MS.fromListWith (++)) $ tokenizeRemoteEndConfig $ filter (/= "") $ lines str+  return RemoteEndPool+    { freeRemoteEnds = freeEnds+    }++tokenizeRemoteEndConfig :: [String] -> Either String [(DriverName, [RemoteEnd])]+tokenizeRemoteEndConfig ls = case ls of+  [] -> return []+  (first:rest) -> do+    driver <- case first of+      "geckodriver" -> return Geckodriver+      "chromedriver" -> return Chromedriver+      _ -> Left $ "Unrecognized driver name '" ++ first ++ "'."+    let (remotes, remainder) = span ("- " `isPrefixOf`) rest+    ends <- mapM (parseRemoteEnd . drop 2) remotes+    config <- tokenizeRemoteEndConfig remainder+    return $ (driver, nub ends) : config++-- | Parse a remote end command line option. This option consists of 0 or more substrings of the form+--+-- > DRIVER_NAME: REMOTE_END_URI REMOTE_END_URI ...+--+-- where `DRIVER_NAME` is either `geckodriver` or `chromedriver` and each `REMOTE_END_URI` is the uri of a WebDriver remote end, including scheme.+parseRemoteEndOption :: String -> Either String RemoteEndPool+parseRemoteEndOption str = do+  freeEnds <- fmap (MS.fromListWith (++)) $ tokenizeRemoteEndOption $ words str+  return RemoteEndPool+    { freeRemoteEnds = freeEnds+    }++tokenizeRemoteEndOption :: [String] -> Either String [(DriverName, [RemoteEnd])]+tokenizeRemoteEndOption ws = case ws of+  [] -> return []+  (first:rest) -> do+    driver <- case first of+      "geckodriver" -> return Geckodriver+      "chromedriver" -> return Chromedriver+      _ -> Left $ "Unrecognized driver name '" ++ first ++ "'."+    let (remotes, remainder) = break (`elem` ["geckodriver","chromedriver"]) rest+    ends <- mapM parseRemoteEnd remotes+    option <- tokenizeRemoteEndOption remainder+    return $ (driver, nub ends) : option++-- | Parse a single remote end URI. Must include the scheme (http:// or https://) even though this is redundant.+parseRemoteEnd :: String -> Either String RemoteEnd+parseRemoteEnd str = case parseURI str of+  Nothing -> Left $ "Could not parse remote end URI '" ++ str ++ "'."+  Just URI{..} -> case uriAuthority of+    Nothing -> Left $ "Error parsing authority for URI '" ++ str ++ "'."+    Just URIAuth{..} -> case uriPort of+      "" -> Right RemoteEnd+        { remoteEndHost = uriUserInfo ++ uriRegName+        , remoteEndPort = 4444+        , remoteEndPath = uriPath+        }+      ':':ds -> case readMaybe ds of+        Nothing -> Left $ "Error parsing port for URI '" ++ str ++ "'."+        Just k -> Right RemoteEnd+          { remoteEndHost = uriUserInfo ++ uriRegName+          , remoteEndPort = k+          , remoteEndPath = uriPath+          }+      p -> Left $ "Unexpected port '" ++ p ++ "' in URI '" ++ str ++ "'."+++-- | Helper function for parsing command line options with a required argument. Assumes long-form option names starting with a hyphen. Note the return type; @Just Nothing@ indicates that the option was not present, while @Nothing@ indicates that the option was present but its required argument was not.+parseOptionWithArgument+  :: String -- ^ Option to parse for, including hyphen(s).+  -> [String] -- ^ List of command line arguments.+  -> Maybe (Maybe String)+parseOptionWithArgument option args = case args of+  (opt:arg:rest) -> if opt == option+    then case arg of+      '-':_ -> Nothing+      _ -> Just (Just arg)+    else parseOptionWithArgument option (arg:rest)+  _ -> Just Nothing
+ src/Web/Api/WebDriver.hs view
@@ -0,0 +1,27 @@+{- |+Module      : Web.Api.WebDriver+Description : A monad for expressing WebDriver interactions.+Copyright   : 2018, Automattic, Inc.+License     : GPL-3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX+-}++module Web.Api.WebDriver (+    module Web.Api.WebDriver.Assert+  , module Web.Api.WebDriver.Endpoints+  , module Web.Api.WebDriver.Helpers+  , module Web.Api.WebDriver.Monad+  , module Web.Api.WebDriver.Types+  , module Web.Api.WebDriver.Types.Keyboard+  , module Web.Api.WebDriver.Uri+  ) where++import Web.Api.WebDriver.Assert+import Web.Api.WebDriver.Endpoints+import Web.Api.WebDriver.Helpers+import Web.Api.WebDriver.Monad+import Web.Api.WebDriver.Types+import Web.Api.WebDriver.Types.Keyboard+import Web.Api.WebDriver.Uri
+ src/Web/Api/WebDriver/Assert.hs view
@@ -0,0 +1,320 @@+{- |+Module      : Web.Api.WebDriver.Assert+Description : Mini language for making falsifiable assertions.+Copyright   : 2018, Automattic, Inc.+License     : GPL-3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX++In this module we define assertions as first class objects and some helper functions for creating and manipulating them.+-}++{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+module Web.Api.WebDriver.Assert (+  -- * Assertions+    Assertion()+  , success+  , failure+  , AssertionStatement(..)+  , AssertionComment(..)+  , AssertionResult()+  , isSuccess+  , printAssertion++  -- * The `Assert` Class+  , Assert(..)++  -- * Assertion Summaries+  , AssertionSummary(..)+  , summarize+  , summarizeAll+  , printSummary++  -- * Basic Assertions+  , assertSuccessIf+  , assertSuccess+  , assertFailure+  , assertTrue+  , assertFalse+  , assertEqual+  , assertNotEqual+  , assertIsSubstring+  , assertIsNotSubstring+  , assertIsNamedSubstring+  , assertIsNotNamedSubstring+  ) where++import Data.List+  ( unwords, isInfixOf )+import Data.String+  ( IsString, fromString )+import Test.QuickCheck+  ( Arbitrary(..) )++++-- | An `Assertion` consists of the following:+--+-- * A human-readable statement being asserted, which may be either true or false.+-- * A result (either success or failure).+-- * A comment, representing /why/ the assertion was made, to assist in debugging.+--+-- To construct assertions outside this module, use `success` and `failure`.++data Assertion = Assertion+  { assertionStatement :: AssertionStatement+  , assertionComment :: AssertionComment+  , assertionResult :: AssertionResult+  } deriving (Eq, Show)++++-- | Human-readable statement which may be true or false.+newtype AssertionStatement = AssertionStatement+  { theAssertionStatement :: String+  } deriving Eq++instance Show AssertionStatement where+  show = theAssertionStatement++instance IsString AssertionStatement where+  fromString = AssertionStatement++instance Arbitrary AssertionStatement where+  arbitrary = AssertionStatement <$> arbitrary++++-- | Human-readable explanation for why an assertion is made.+newtype AssertionComment = AssertionComment+  { theAssertionComment :: String+  } deriving Eq++instance Show AssertionComment where+  show = theAssertionComment++instance IsString AssertionComment where+  fromString = AssertionComment++instance Arbitrary AssertionComment where+  arbitrary = AssertionComment <$> arbitrary++++-- | Type representing the result (success or failure) of an evaluated assertion.+data AssertionResult+  = AssertSuccess | AssertFailure+  deriving (Eq, Show)++instance Arbitrary AssertionResult where+  arbitrary = do+    p <- arbitrary+    return $ if p then AssertSuccess else AssertFailure++-- | Detects successful assertions.+isSuccess :: Assertion -> Bool+isSuccess a = AssertSuccess == assertionResult a++++-- | Basic string representation of an assertion.+printAssertion :: Assertion -> String+printAssertion Assertion{..} =+  case assertionResult of+    AssertSuccess -> +      unwords+        [ "\x1b[1;32mValid Assertion\x1b[0;39;49m"+        , "\nassertion: " ++ show assertionStatement+        , "\ncomment: " ++ show assertionComment+        ]+    AssertFailure ->+      unwords+        [ "\x1b[1;31mInvalid Assertion\x1b[0;39;49m"+        , "\nassertion: " ++ show assertionStatement+        , "\ncomment: " ++ show assertionComment+        ]++++-- | Construct a successful assertion.+success+  :: AssertionStatement -- ^ Statement being asserted (the /what/)+  -> AssertionComment -- ^ An additional comment (the /why/)+  -> Assertion+success statement comment = Assertion+  { assertionStatement = statement+  , assertionComment = comment+  , assertionResult = AssertSuccess+  }++-- | Construct a failed assertion.+failure+  :: AssertionStatement -- ^ Statement being asserted (the /what/)+  -> AssertionComment -- ^ An additional comment (the /why/)+  -> Assertion+failure statement comment = Assertion+  { assertionStatement = statement+  , assertionComment = comment+  , assertionResult = AssertFailure+  }++++-- | Assertions are made and evaluated inside some context, represented by the `Assert` class.+class Assert m where+  -- | Make an assertion. Typically @m@ is a monad, and the `Assert` instance handles the assertion in @m@ by e.g. logging it, changing state, etc.+  assert :: Assertion -> m ()++++-- | Generic boolean assertion; asserts success if @Bool@ is true and failure otherwise.+assertSuccessIf+  :: (Monad m, Assert m)+  => Bool+  -> AssertionStatement -- ^ Statement being asserted (the /what/)+  -> AssertionComment -- ^ An additional comment (the /why/)+  -> m ()+assertSuccessIf p statement comment =+  assert $ (if p then success else failure) statement comment++-- | Assertion that always succeeds.+assertSuccess+  :: (Monad m, Assert m)+  => AssertionComment -- ^ An additional comment (the /why/)+  -> m ()+assertSuccess = assertSuccessIf True (AssertionStatement "Success!")++-- | Assertion that always fails.+assertFailure+  :: (Monad m, Assert m)+  => AssertionComment -- ^ An additional comment (the /why/)+  -> m ()+assertFailure = assertSuccessIf False (AssertionStatement "Failure :(")++-- | Succeeds if @Bool@ is `True`.+assertTrue+  :: (Monad m, Assert m)+  => Bool+  -> AssertionComment -- ^ An additional comment (the /why/)+  -> m ()+assertTrue p = assertSuccessIf p+  (AssertionStatement $ show p ++ " is True")++-- | Succeeds if @Bool@ is `False`.+assertFalse+  :: (Monad m, Assert m)+  => Bool+  -> AssertionComment -- ^ An additional comment (the /why/)+  -> m ()+assertFalse p = assertSuccessIf (not p)+  (AssertionStatement $ show p ++ " is False")++-- | Succeeds if the given @t@s are equal according to their `Eq` instance.+assertEqual+  :: (Monad m, Assert m, Eq t, Show t)+  => t+  -> t+  -> AssertionComment -- ^ An additional comment (the /why/)+  -> m ()+assertEqual x y = assertSuccessIf (x == y)+  (AssertionStatement $ show x ++ " is equal to " ++ show y)++-- | Succeeds if the given @t@s are not equal according to their `Eq` instance.+assertNotEqual+  :: (Monad m, Assert m, Eq t, Show t)+  => t+  -> t+  -> AssertionComment -- ^ An additional comment (the /why/)+  -> m ()+assertNotEqual x y = assertSuccessIf (x /= y)+  (AssertionStatement $ show x ++ " is not equal to " ++ show y)++-- | Succeeds if the first list is an infix of the second, according to their `Eq` instance.+assertIsSubstring+  :: (Monad m, Assert m, Eq a, Show a)+  => [a]+  -> [a]+  -> AssertionComment -- ^ An additional comment (the /why/)+  -> m ()+assertIsSubstring x y = assertSuccessIf (x `isInfixOf` y)+  (AssertionStatement $ show x ++ " is a substring of " ++ show y)++-- | Succeeds if the first list is not an infix of the second, according to their `Eq` instance.+assertIsNotSubstring+  :: (Monad m, Assert m, Eq a, Show a)+  => [a]+  -> [a]+  -> AssertionComment -- ^ An additional comment (the /why/)+  -> m ()+assertIsNotSubstring x y = assertSuccessIf (not $ x `isInfixOf` y)+  (AssertionStatement $ show x ++ " is not a substring of " ++ show y)++-- | Succeeds if the first list is an infix of the second, named list, according to their `Eq` instance. This is similar to `assertIsSubstring`, except that the "name" of the second list argument is used in reporting failures. Handy if the second list is very large -- say the source of a webpage.+assertIsNamedSubstring+  :: (Monad m, Assert m, Eq a, Show a)+  => [a]+  -> ([a],String)+  -> AssertionComment -- ^ An additional comment (the /why/)+  -> m ()+assertIsNamedSubstring x (y,name) = assertSuccessIf (x `isInfixOf` y)+  (AssertionStatement $ show x ++ " is a substring of " ++ name)++-- | Succeeds if the first list is not an infix of the second, named list, according to their `Eq` instance. This is similar to `assertIsNotSubstring`, except that the "name" of the second list argument is used in reporting failures. Handy if the second list is very large -- say the source of a webpage.+assertIsNotNamedSubstring+  :: (Monad m, Assert m, Eq a, Show a)+  => [a]+  -> ([a],String)+  -> AssertionComment -- ^ An additional comment (the /why/)+  -> m ()+assertIsNotNamedSubstring x (y,name) = assertSuccessIf (not $ isInfixOf x y)+  (AssertionStatement $ show x ++ " is not a substring of " ++ name)++++-- | `Assertion`s are the most granular kind of "test" this library deals with. Typically we'll be interested in sets of many assertions. A single test case will include one or more assertions, which for reporting purposes we'd like to summarize. The summary for a list of assertions will include the number of successes, the number of failures, and the actual failures. Modeled this way assertion summaries form a monoid, which is handy.++data AssertionSummary = AssertionSummary+  { numSuccesses :: Integer+  , numFailures :: Integer+  , failures :: [Assertion]+  , successes :: [Assertion]+  } deriving (Eq, Show)++instance Monoid AssertionSummary where+  mempty = AssertionSummary 0 0 [] []++  mappend x y = AssertionSummary+    { numSuccesses = numSuccesses x + numSuccesses y+    , numFailures = numFailures x + numFailures y+    , failures = failures x ++ failures y+    , successes = successes x ++ successes y+    }++-- | Summarize a single assertion.+summary :: Assertion -> AssertionSummary+summary x = AssertionSummary+  { numSuccesses = if isSuccess x then 1 else 0+  , numFailures = if isSuccess x then 0 else 1+  , failures = if isSuccess x then [] else [x]+  , successes = if isSuccess x then [x] else []+  }++-- | Summarize a list of `Assertion`s.+summarize :: [Assertion] -> AssertionSummary+summarize = mconcat . map summary++-- | Summarize a list of `AssertionSummary`s.+summarizeAll :: [AssertionSummary] -> AssertionSummary+summarizeAll = mconcat++-- | Very basic string representation of an `AssertionSummary`.+printSummary :: AssertionSummary -> IO ()+printSummary AssertionSummary{..} = do+  mapM_ (putStrLn . printAssertion) failures+  putStrLn $ "Assertions: " ++ show (numSuccesses + numFailures)+  putStrLn $ "Failures: " ++ show numFailures++-- | Total number of assertions made.+numAssertions :: AssertionSummary -> Integer+numAssertions x = numSuccesses x + numFailures x
+ src/Web/Api/WebDriver/Classes.hs view
@@ -0,0 +1,32 @@+{- |+Module      : Web.Api.WebDriver.Classes+Description : Utility typeclasses+Copyright   : 2018, Automattic, Inc.+License     : GPL-3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX+-}++module Web.Api.WebDriver.Classes (+    HasElementRef(..)+  , HasContextId(..)+) where++import Web.Api.WebDriver.Types++-- | Types which carry a /web element reference/ as described in https://www.w3.org/TR/webdriver/#elements.+class HasElementRef t where+  elementRefOf :: t -> ElementRef++instance HasElementRef ElementRef where+  elementRefOf = id++++-- | Types which carry a /window handle/ as described in https://www.w3.org/TR/webdriver/#command-contexts.+class HasContextId t where+  contextIdOf :: t -> ContextId++instance HasContextId ContextId where+  contextIdOf = id
+ src/Web/Api/WebDriver/Endpoints.hs view
@@ -0,0 +1,1185 @@+{- |+Module      : Web.Api.WebDriver.Endpoints+Description : Type-safe bindings for the WebDriver HTTP API.+Copyright   : 2018, Automattic, Inc.+License     : GPL-3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX++These bindings try to stick as closely to the spec as possible. We use the following conventions.++* The @Stealth@ suffix on a function indicates that it does not log request or response data (but it does log that a request/response occurred).+* A prime (@'@) on a POST function name indicates that it takes an additional function parameter that mutates the payload after it is converted to JSON, but before sending the request. This is a cheap way to future-proof the bindings and accommodate nonstandard request parameters.++The most recent version of the spec is available at <https://w3c.github.io/webdriver/webdriver-spec.html>.+-}++{-# LANGUAGE OverloadedStrings, BangPatterns #-}+module Web.Api.WebDriver.Endpoints (+    runIsolated++  -- * Sessions+  -- ** New Session+  , newSession+  , newSession'+  -- ** Delete Session+  , deleteSession+  -- ** Status+  , sessionStatus+  -- ** Get Timeouts+  , getTimeouts+  -- ** Set Timeouts+  , setTimeouts++  -- * Navigation+  -- ** Navigate To+  , navigateTo+  , navigateToStealth+  -- ** Get Current URL+  , getCurrentUrl+  -- ** Go Back+  , goBack+  -- ** Go Forward+  , goForward+  -- ** Page Refresh+  , pageRefresh+  -- ** Get Title+  , getTitle++  -- * Command Contexts+  -- ** Get Window Handle+  , getWindowHandle+  -- ** Close Window+  , closeWindow+  -- ** Switch To Window+  , switchToWindow+  -- ** Get Window Handles+  , getWindowHandles+  -- ** Switch To Frame+  , switchToFrame+  -- ** Switch To Parent Frame+  , switchToParentFrame+  -- ** Get Window Rect+  , getWindowRect+  -- ** Set Window Rect+  , setWindowRect+  -- ** Maximize Window+  , maximizeWindow+  -- ** Minimize Window+  , minimizeWindow+  -- ** Fullscreen Window+  , fullscreenWindow++  -- * Element Retrieval+  -- ** Find Element+  , findElement+  -- ** Find Elements+  , findElements+  -- ** Find Element From Element+  , findElementFromElement+  -- ** Find Elements From Element+  , findElementsFromElement+  -- ** Get Active Element+  , getActiveElement++  -- * Element State+  -- ** Is Element Selected+  , isElementSelected+  -- ** Get Element Attribute+  , getElementAttribute+  -- ** Get Element Property+  , getElementProperty+  -- ** Get Element CSS Value+  , getElementCssValue+  -- ** Get Element Text+  , getElementText+  -- ** Get Element Tag Name+  , getElementTagName+  -- ** Get Element Rect+  , getElementRect+  -- ** Is Element Enabled+  , isElementEnabled++  -- * Element Interaction+  -- ** Element Click+  , elementClick+  -- ** Element Clear+  , elementClear+  -- ** Element Send Keys+  , elementSendKeys++  -- * Document Handling+  -- ** Get Page Source+  , getPageSource+  , getPageSourceStealth+  -- ** Execute Script+  , executeScript+  -- ** Execute Async Script+  , executeAsyncScript++  -- * Cookies+  -- ** Get All Cookies+  , getAllCookies+  -- ** Get Named Cookie+  , getNamedCookie+  -- ** Add Cookie+  , addCookie+  -- ** Delete Cookie+  , deleteCookie+  -- ** Delete All Cookies+  , deleteAllCookies++  -- * Actions+  -- ** Perform Actions+  , performActions+  , performActionsStealth+  -- ** Release Actions+  , releaseActions++  -- * User Prompts+  -- ** Dismiss Alert+  , dismissAlert+  -- ** Accept Alert+  , acceptAlert+  -- ** Get Alert Text+  , getAlertText+  -- ** Send Alert Text+  , sendAlertText++  -- * Screen Capture+  -- ** Take Screenshot+  , takeScreenshot+  -- ** Take Element Screenshot+  , takeElementScreenshot++  -- Spec Constants+  , _WEB_ELEMENT_ID+  , _WEB_WINDOW_ID+  , _WEB_FRAME_ID+  ) where++import Data.Aeson+  ( Value(..), encode, object, (.=), toJSON )+import Data.Text+  ( Text, unpack, pack )+import Data.Text.Encoding+  ( encodeUtf8 )+import qualified Data.ByteString as SB+import qualified Data.ByteString.Base64 as B64+import qualified Network.URI.Encode as E++import Web.Api.WebDriver.Types+import Web.Api.WebDriver.Classes+import Web.Api.WebDriver.Monad++++-- | Spec-defined "web element identifier" string constant. See <https://w3c.github.io/webdriver/webdriver-spec.html#elements>.+_WEB_ELEMENT_ID :: Text+_WEB_ELEMENT_ID = "element-6066-11e4-a52e-4f735466cecf"++-- | Spec-defined "web window identifier" string constant. See <https://w3c.github.io/webdriver/webdriver-spec.html#command-contexts>.+_WEB_WINDOW_ID :: Text+_WEB_WINDOW_ID =  "window-fcc6-11e5-b4f8-330a88ab9d7f"++-- | Spec-defined "web frame identifier" string constant. See <https://w3c.github.io/webdriver/webdriver-spec.html#command-contexts>.+_WEB_FRAME_ID :: Text+_WEB_FRAME_ID = "frame-075b-4da1-b6ba-e579c2d3230a"++++++-- | Url of the remote WebDriver server.+theRemoteUrl :: (Monad m) => WebDriverT m String+theRemoteUrl = do+  host <- fromEnv (_remoteHostname . _env)+  port <- fromEnv (_remotePort . _env)+  path <- fromEnv (_remotePath . _env)+  return $ concat [ "http://", host, ":", show port, path]++-- | Url of the remote WebDriver server, with session ID.+theRemoteUrlWithSession :: (Monad m) => WebDriverT m String+theRemoteUrlWithSession = do+  st <- fromState (_sessionId . _userState)+  case st of+    Nothing -> throwError NoSession+    Just session_id -> do+      baseUrl <- theRemoteUrl+      return $ concat [ baseUrl, "/session/", session_id ]++-- | Set the session id of a `WDState`.+setSessionId+  :: Maybe String+  -> S WDState+  -> S WDState+setSessionId x st = st { _userState = (_userState st) { _sessionId = x } }++-- | If a WebDriver session ends without issuing a delete session command, then the server keeps its session state alive. `cleanupOnError` catches errors and ensures that a `deleteSession` request is sent.+cleanupOnError+  :: (Monad m)+  => WebDriverT m a -- ^ `WebDriver` session that may throw errors+  -> WebDriverT m a+cleanupOnError x = catchError x $ \e ->+  deleteSession >> throwError e++-- | Run a WebDriver computation in an isolated browser session. Ensures that the session is closed on the remote end.+runIsolated+  :: (Monad m)+  => Capabilities+  -> WebDriverT m a+  -> WebDriverT m ()+runIsolated caps theSession = cleanupOnError $ do+  session_id <- newSession caps+  modifyState $ setSessionId (Just session_id)+  theSession+  deleteSession+  modifyState $ setSessionId Nothing++++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#new-session>. For an extensible version allowing arbitrary changes to the JSON value representing the `Capabilities` parameter, see `newSession'`.+newSession+  :: (Monad m)+  => Capabilities+  -> WebDriverT m SessionId+newSession = newSession' id+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#new-session>. This generalizes `newSession'` by taking an additional function @Value -> Value@ that is applied to the `Capabilities` parameter after it is converted to JSON, but before it is passed to the HTTP call.+newSession'+  :: (Monad m)+  => (Value -> Value)+  -> Capabilities+  -> WebDriverT m SessionId+newSession' f caps = do+  baseUrl <- theRemoteUrl+  format <- fromEnv (_responseFormat . _env)+  let+    !payload = encode $ f $ object+      [ "capabilities" .= object+        [ "alwaysMatch" .= toJSON caps ]+      , "desiredCapabilities" .= toJSON caps+      ]+  httpPost (baseUrl ++ "/session") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= case format of+          SpecFormat -> lookupKeyJson "value"+          ChromeFormat -> return+    >>= lookupKeyJson "sessionId"+    >>= constructFromJson+    >>= (return . unpack)+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#delete-session>.+deleteSession+  :: (Monad m) => WebDriverT m ()+deleteSession = do+  (baseUrl, format) <- theRequestContext+  httpDelete baseUrl+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#status>.+sessionStatus+  :: (Monad m)+  => WebDriverT m (Bool, String)+sessionStatus = do+  baseUrl <- theRemoteUrl+  format <- fromEnv (_responseFormat . _env)+  r <- httpGet (baseUrl ++ "/status")+    >>= (return . _responseBody)+    >>= parseJson+  ready <- case format of+    SpecFormat ->+      lookupKeyJson "value" r+        >>= lookupKeyJson "ready"+        >>= constructFromJson+    ChromeFormat -> return True+  msg <- case format of+    SpecFormat ->+      lookupKeyJson "value" r+        >>= lookupKeyJson "message"+        >>= constructFromJson+        >>= (return . unpack)+    ChromeFormat -> return "chromedriver is not spec compliant :)"+  return (ready, msg)+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-timeouts>.+getTimeouts+  :: (Monad m)+  => WebDriverT m TimeoutConfig+getTimeouts = do+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/timeouts")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#set-timeouts>.+setTimeouts+  :: (Monad m)+  => TimeoutConfig+  -> WebDriverT m ()+setTimeouts timeouts = do+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode timeouts+  httpPost (baseUrl ++ "/timeouts") payload+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#navigate-to>. To access this enpoint without logging the request or the result, use `navigateToStealth`.+navigateTo+  :: (Monad m)+  => Url+  -> WebDriverT m ()+navigateTo url = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object [ "url" .= url ]+  httpPost (baseUrl ++ "/url") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#navigate-to>. This function does not log the request or response; if you do want the interaction logged, use `navigateTo`.+navigateToStealth+  :: (Monad m)+  => Url+  -> WebDriverT m ()+navigateToStealth url = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object [ "url" .= url ]+  httpSilentPost (baseUrl ++ "/url") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-current-url>.+getCurrentUrl+  :: (Monad m)+  => WebDriverT m Url+getCurrentUrl = do+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/url")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= (return . unpack)+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#back>.+goBack+  :: (Monad m)+  => WebDriverT m ()+goBack = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object []+  httpPost (baseUrl ++ "/back") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#forward>.+goForward+  :: (Monad m)+  => WebDriverT m ()+goForward = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object []+  httpPost (baseUrl ++ "/forward") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#refresh>.+pageRefresh+  :: (Monad m)+  => WebDriverT m ()+pageRefresh = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object []+  httpPost (baseUrl ++ "/refresh") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-title>.+getTitle+  :: (Monad m)+  => WebDriverT m String+getTitle = do+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/title")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= (return . unpack)+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-window-handle>.+getWindowHandle+  :: (Monad m)+  => WebDriverT m ContextId+getWindowHandle = do+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/window")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= (return . ContextId . unpack)+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#close-window>.+closeWindow+  :: (Monad m)+  => WebDriverT m [ContextId]+closeWindow = do+  baseUrl <- theRemoteUrlWithSession+  httpDelete (baseUrl ++ "/window")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= (sequence . map constructFromJson)+    >>= (return . map (ContextId . unpack))+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#switch-to-window>.+switchToWindow+  :: (Monad m, HasContextId t)+  => t+  -> WebDriverT m ()+switchToWindow t = do+  let contextId = contextIdOf t+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode $ object [ "handle" .= show contextId ]+  httpPost (baseUrl ++ "/window") payload+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-window-handles>.+getWindowHandles+  :: (Monad m)+  => WebDriverT m [ContextId]+getWindowHandles = do+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/window/handles")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= (sequence . map constructFromJson)+    >>= (return . map (ContextId . unpack))+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#switch-to-frame>.+switchToFrame+  :: (Monad m)+  => FrameReference+  -> WebDriverT m ()+switchToFrame ref = do+  (baseUrl, format) <- theRequestContext+  let+    !frame = case ref of+      TopLevelFrame -> Null+      FrameNumber k -> Number $ fromIntegral k+      FrameContainingElement element_id -> String $ pack $ show element_id++    !payload = encode $ object+      [ "id" .= toJSON frame ]++  httpPost (baseUrl ++ "/frame") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= case format of+          SpecFormat -> expect (object [])+          ChromeFormat -> expect Null+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#switch-to-parent-frame>.+switchToParentFrame+  :: (Monad m)+  => WebDriverT m ()+switchToParentFrame = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object []+  httpPost (baseUrl ++ "/frame/parent") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-window-rect>.+getWindowRect+  :: (Monad m)+  => WebDriverT m Rect+getWindowRect = do+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/window/rect")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#set-window-rect>.+setWindowRect+  :: (Monad m)+  => Rect+  -> WebDriverT m Rect+setWindowRect rect = do+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode rect+  httpPost (baseUrl ++ "/window/rect") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#maximize-window>.+maximizeWindow+  :: (Monad m)+  => WebDriverT m Rect+maximizeWindow = do+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode $ object []+  httpPost (baseUrl ++ "/window/maximize") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#minimize-window>.+minimizeWindow+  :: (Monad m)+  => WebDriverT m Rect+minimizeWindow = do+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode $ object []+  httpPost (baseUrl ++ "/window/minimize") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#fullscreen-window>.+fullscreenWindow+  :: (Monad m)+  => WebDriverT m Rect+fullscreenWindow = do+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode $ object []+  httpPost (baseUrl ++ "/window/fullscreen") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#find-element>.+findElement+  :: (Monad m)+  => LocationStrategy+  -> Selector+  -> WebDriverT m ElementRef+findElement strategy selector = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object [ "value" .= selector, "using" .= toJSON strategy ]+  httpPost (baseUrl ++ "/element") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= case format of+          SpecFormat -> lookupKeyJson _WEB_ELEMENT_ID+          ChromeFormat -> lookupKeyJson "ELEMENT"+    >>= constructFromJson+    >>= (return . ElementRef . unpack)+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#find-elements>.+findElements+  :: (Monad m)+  => LocationStrategy+  -> Selector+  -> WebDriverT m [ElementRef]+findElements strategy selector = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object [ "value" .= selector, "using" .= toJSON strategy ]+  httpPost (baseUrl ++ "/elements") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= case format of+          SpecFormat -> mapM (lookupKeyJson _WEB_ELEMENT_ID)+          ChromeFormat -> mapM (lookupKeyJson "ELEMENT")+    >>= mapM constructFromJson+    >>= (return . map (ElementRef . unpack))+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#find-element-from-element>.+findElementFromElement+  :: (Monad m, HasElementRef t)+  => LocationStrategy+  -> Selector+  -> t+  -> WebDriverT m ElementRef+findElementFromElement strategy selector root = do+  (baseUrl, format) <- theRequestContext+  let root_id = elementRefOf root+  let !payload = encode $ object [ "value" .= selector, "using" .= toJSON strategy ]+  httpPost (baseUrl ++ "/element/" ++ show root_id ++ "/element") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= case format of+          SpecFormat -> lookupKeyJson _WEB_ELEMENT_ID+          ChromeFormat -> lookupKeyJson "ELEMENT"+    >>= constructFromJson+    >>= (return . ElementRef . unpack)+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#find-elements-from-element>.+findElementsFromElement+  :: (Monad m, HasElementRef t)+  => LocationStrategy+  -> Selector+  -> t+  -> WebDriverT m [ElementRef]+findElementsFromElement strategy selector root = do+  (baseUrl, format) <- theRequestContext+  let root_id = elementRefOf root+  let !payload = encode $ object [ "value" .= selector, "using" .= toJSON strategy ]+  httpPost (baseUrl ++ "/element/" ++ show root_id ++ "/elements") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= case format of+          SpecFormat -> mapM (lookupKeyJson _WEB_ELEMENT_ID)+          ChromeFormat -> mapM (lookupKeyJson "ELEMENT")+    >>= mapM constructFromJson+    >>= (return . map (ElementRef . unpack))+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-active-element>.+getActiveElement+  :: (Monad m)+  => WebDriverT m ElementRef+getActiveElement = do+  (baseUrl, format) <- theRequestContext+  httpGet (baseUrl ++ "/element/active")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= case format of+          SpecFormat -> lookupKeyJson _WEB_ELEMENT_ID+          ChromeFormat -> lookupKeyJson "ELEMENT"+    >>= constructFromJson+    >>= (return . ElementRef . unpack)+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#is-element-selected>.+isElementSelected+  :: (Monad m, HasElementRef t)+  => t+  -> WebDriverT m Bool+isElementSelected element = do+  let elementRef = show $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/selected")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-element-attribute>.+getElementAttribute+  :: (Monad m, HasElementRef t)+  => t+  -> AttributeName+  -> WebDriverT m (Either Bool String)+getElementAttribute element name = do+  let elementRef = show $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  x <- httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/attribute/" ++ E.encode name)+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+  case x of+    Null -> return (Left False)+    String "true" -> return (Left True)+    String attr -> return (Right $ unpack attr)+    _ -> throwJsonError $ JsonError "Invalid element attribute response"+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-element-property>.+getElementProperty+  :: (Monad m, HasElementRef t)+  => t+  -> PropertyName+  -> WebDriverT m Value+getElementProperty element name = do+  let elementRef = show $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/property/" ++ E.encode name)+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-element-css-value>.+getElementCssValue+  :: (Monad m, HasElementRef t)+  => t+  -> CssPropertyName+  -> WebDriverT m String+getElementCssValue element name = do+  let elementRef = show $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/css/" ++ name)+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-element-text>.+getElementText+  :: (Monad m, HasElementRef t)+  => t+  -> WebDriverT m String+getElementText element = do+  let elementRef = show $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/text")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-element-tag-name>.+getElementTagName+  :: (Monad m, HasElementRef t)+  => t+  -> WebDriverT m String+getElementTagName element = do+  let elementRef = show $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/name")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-element-rect>.+getElementRect+  :: (Monad m, HasElementRef t)+  => t+  -> WebDriverT m Rect+getElementRect element = do+  let elementRef = show $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/rect")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#is-element-enabled>.+isElementEnabled+  :: (Monad m, HasElementRef t)+  => t+  -> WebDriverT m Bool+isElementEnabled element = do+  let elementRef = show $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/enabled")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#element-click>.+elementClick+  :: (Monad m, HasElementRef t)+  => t+  -> WebDriverT m ()+elementClick element = do+  (baseUrl, format) <- theRequestContext+  let elementRef = show $ elementRefOf element+  let !payload = encode $ object []+  httpPost (baseUrl ++ "/element/" ++ elementRef ++ "/click") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#element-clear>.+elementClear+  :: (Monad m, HasElementRef t)+  => t+  -> WebDriverT m ()+elementClear element = do+  (baseUrl, format) <- theRequestContext+  let elementRef = show $ elementRefOf element+  let !payload = encode $ object []+  httpPost (baseUrl ++ "/element/" ++ elementRef ++ "/clear") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#element-send-keys>.+elementSendKeys+  :: (Monad m, HasElementRef t)+  => t+  -> String+  -> WebDriverT m ()+elementSendKeys element text = do+  let elementRef = show $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode $ object [ "text" .= text ]+  httpPost (baseUrl ++ "/element/" ++ elementRef ++ "/value") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expect (object [])+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-page-source>.+getPageSource+  :: (Monad m)+  => WebDriverT m String+getPageSource = do+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/source")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= (return . unpack)+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-page-source>. Does not dump the page source into the logs. :)+getPageSourceStealth+  :: (Monad m)+  => WebDriverT m String+getPageSourceStealth = do+  baseUrl <- theRemoteUrlWithSession+  httpSilentGet (baseUrl ++ "/source")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= (return . unpack)+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#execute-script>.+executeScript+  :: (Monad m)+  => Script+  -> [Value]+  -> WebDriverT m Value+executeScript script args = do+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode $ object [ "script" .= script, "args" .= toJSON args ]+  httpPost (baseUrl ++ "/execute/sync") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#execute-async-script>.+executeAsyncScript+  :: (Monad m)+  => Script+  -> [Value]+  -> WebDriverT m Value+executeAsyncScript script args = do+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode $ object [ "script" .= script, "args" .= toJSON args ]+  httpPost (baseUrl ++ "/execute/async") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-all-cookies>.+getAllCookies+  :: (Monad m)+  => WebDriverT m [Cookie]+getAllCookies = do+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/cookie")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= mapM constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-named-cookie>.+getNamedCookie+  :: (Monad m)+  => CookieName+  -> WebDriverT m Cookie+getNamedCookie name = do+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl ++ "/cookie/" ++ E.encode name)+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#add-cookie>.+addCookie+  :: (Monad m)+  => Cookie+  -> WebDriverT m ()+addCookie cookie = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object [ "cookie" .= cookie ]+  httpSilentPost (baseUrl ++ "/cookie") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#delete-cookie>.+deleteCookie+  :: (Monad m)+  => CookieName+  -> WebDriverT m ()+deleteCookie name = do+  (baseUrl, format) <- theRequestContext+  httpDelete (baseUrl ++ "/cookie/" ++ E.encode name)+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#delete-all-cookies>.+deleteAllCookies+  :: (Monad m)+  => WebDriverT m ()+deleteAllCookies = do+  (baseUrl, format) <- theRequestContext+  httpDelete (baseUrl ++ "/cookie")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#perform-actions>. For a variant on this endpoint that does not log the request and response, see `performActionsStealth`.+performActions+  :: (Monad m)+  => [Action]+  -> WebDriverT m ()+performActions = _performActions False+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#perform-actions>. This function is identical to `performActions` except that it does not log the request or response. Handy if the action includes secret info.+performActionsStealth+  :: (Monad m)+  => [Action]+  -> WebDriverT m ()+performActionsStealth = _performActions True+++_performActions+  :: (Monad m)+  => Bool+  -> [Action]+  -> WebDriverT m ()+_performActions stealth action = do+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode $ object [ "actions" .= toJSON action ]+  let httpMethod = if stealth then httpSilentPost else httpPost+  httpMethod (baseUrl ++ "/actions") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expect (object [])+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#release-actions>.+releaseActions+  :: (Monad m)+  => WebDriverT m ()+releaseActions = do+  baseUrl <- theRemoteUrlWithSession+  httpDelete (baseUrl ++ "/actions")+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dismiss-alert>.+dismissAlert+  :: (Monad m)+  => WebDriverT m ()+dismissAlert = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object []+  httpPost (baseUrl ++ "/alert/dismiss") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#accept-alert>.+acceptAlert+  :: (Monad m)+  => WebDriverT m ()+acceptAlert = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object []+  httpPost (baseUrl ++ "/alert/accept") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-alert-text>.+getAlertText+  :: (Monad m)+  => WebDriverT m (Maybe String)+getAlertText = do+  baseUrl <- theRemoteUrlWithSession+  msg <- httpGet (baseUrl ++ "/alert/text")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+  case msg of+    Null -> return Nothing+    String text -> return $ Just (unpack text)+    _ -> throwJsonError $ JsonError "Invalid alert text response"+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#send-alert-text>.+sendAlertText+  :: (Monad m)+  => String+  -> WebDriverT m ()+sendAlertText msg = do+  (baseUrl, format) <- theRequestContext+  let !payload = encode $ object [ "text" .= msg ]+  httpPost (baseUrl ++ "/alert/text") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= expectEmptyObject format+  return ()+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#take-screenshot>.+takeScreenshot+  :: (Monad m)+  => WebDriverT m SB.ByteString+takeScreenshot = do+  baseUrl <- theRemoteUrlWithSession+  result <- httpGet (baseUrl ++ "/screenshot")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= (return . B64.decode . encodeUtf8)+  case result of+    Right img -> return img+    Left str -> throwError $ ImageDecodeError str+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#take-element-screenshot>.+takeElementScreenshot+  :: (Monad m, HasElementRef t)+  => t+  -> WebDriverT m SB.ByteString+takeElementScreenshot element = do+  let elementRef = show $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  result <- httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/screenshot")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+    >>= (return . B64.decode . encodeUtf8)+  case result of+    Right img -> return img+    Left str -> throwError $ ImageDecodeError str+++-- | Detect empty responses by response format. Necessary because chromedriver is not strictly spec compliant.+expectEmptyObject+  :: (Monad m)+  => ResponseFormat+  -> Value+  -> WebDriverT m Value+expectEmptyObject format value = case format of+  SpecFormat -> expect (object []) value+  ChromeFormat -> expect Null value+++theRequestContext+  :: (Monad m)+  => WebDriverT m (String, ResponseFormat)+theRequestContext = do+  baseUrl <- theRemoteUrlWithSession+  format <- fromEnv (_responseFormat . _env)+  return (baseUrl, format)
+ src/Web/Api/WebDriver/Helpers.hs view
@@ -0,0 +1,115 @@+{- |+Module      : Web.Api.WebDriver.Helpers+Description : Higher level WebDriver utilities.+Copyright   : 2018, Automattic, Inc.+License     : GPL-3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX+-}++module Web.Api.WebDriver.Helpers (+  -- * Secrets+    stashCookies+  , loadCookies++  -- * Actions+  , press+  , typeString+  ) where++import qualified Data.Aeson as Aeson+  ( encode )+import qualified Data.ByteString.Lazy.Char8 as BS+  ( pack )+import qualified Data.Digest.Pure.SHA as SHA+  ( showDigest, sha1 )++import Web.Api.WebDriver.Endpoints+import Web.Api.WebDriver.Monad+import Web.Api.WebDriver.Types+import Web.Api.WebDriver.Types.Keyboard++++++-- | Save all cookies for the current domain to a file.+stashCookies+  :: (Monad m)+  => String -- ^ Passed through SHA1, and the digest is used as the filename.+  -> WebDriverT m ()+stashCookies string =+  let file = SHA.showDigest $ SHA.sha1 $ BS.pack string in+  getAllCookies >>= writeCookieFile file+++-- | Load cookies from a file saved with `stashCookies`. Returns `False` if the cookie file is missing or cannot be read.+loadCookies+  :: (Monad m)+  => String -- ^ Passed through SHA1, and the digest is used as the filename.+  -> WebDriverT m Bool+loadCookies string = do+  let file = SHA.showDigest $ SHA.sha1 $ BS.pack string+  contents <- readCookieFile file+  case contents of+    Nothing -> return False+    Just cs -> do+      mapM_ addCookie cs+      return True+++-- | Write cookies to a file under the secrets path. +writeCookieFile+  :: (Monad m)+  => FilePath -- ^ File path; relative to @$DATA_PATH\/secrets\/cookies\/@+  -> [Cookie]+  -> WebDriverT m ()+writeCookieFile file cookies = do+  path <- fromEnv (_dataPath . _env)+  let fullpath = path ++ "/secrets/cookies/" ++ file+  writeFilePath fullpath (Aeson.encode cookies)+++-- | Read cookies from a file stored with `writeCookieFile`. Returns `Nothing` if the file does not exist.+readCookieFile+  :: (Monad m)+  => FilePath -- ^ File path; relative to @$DATA_PATH\/secrets\/cookies\/@+  -> WebDriverT m (Maybe [Cookie])+readCookieFile file = do+  path <- fromEnv (_dataPath . _env)+  let fullpath = path ++ "/secrets/cookies/" ++ file+  cookieFileExists <- fileExists fullpath+  if cookieFileExists+    then readFilePath fullpath+      >>= parseJson+      >>= constructFromJson+      >>= mapM constructFromJson+      >>= (return . Just)+    else return Nothing+++-- | `KeyDownAction` with the given `Char`.+keypress :: Char -> ActionItem+keypress x = emptyActionItem+  { _actionType = Just KeyDownAction+  , _actionValue = Just [x]+  }+++-- | Simulate pressing a `Key`.+press :: Key -> Action+press key = emptyAction+  { _inputSourceType = Just KeyInputSource+  , _inputSourceId = Just "kbd"+  , _actionItems = [keypress (keyToChar key)]+  }+++-- | Simulate typing some text.+typeString :: String -> Action+typeString x = emptyAction+  { _inputSourceType = Just KeyInputSource+  , _inputSourceId = Just "kbd"+  , _actionItems = map keypress x+  }
+ src/Web/Api/WebDriver/Monad.hs view
@@ -0,0 +1,714 @@+{- |+Module      : Web.Api.WebDriver.Monad+Description : A WebDriver session monad.+Copyright   : 2018, Automattic, Inc.+License     : GPL-3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX++A monad and monad transformer for +-}++{-# LANGUAGE GADTs, Rank2Types, OverloadedStrings #-}+module Web.Api.WebDriver.Monad (+    WebDriver+  , execWebDriver+  , debugWebDriver+  , checkWebDriver++  , WebDriverT()+  , execWebDriverT+  , debugWebDriverT+  , checkWebDriverT+  , liftWebDriverT+  , IdentityT(..)++  , evalWDAct+  , Http.evalIO+  , evalWDActMockIO+  , Http.evalMockIO++  -- * Config+  , WebDriverConfig(..)+  , defaultWebDriverConfig+  , defaultWebDriverState+  , defaultWebDriverEnvironment+  , defaultWDEnv+  , defaultWebDriverLogOptions++  -- * API+  , fromState+  , modifyState+  , fromEnv+  , comment+  , wait+  , throwError+  , throwJsonError+  , throwHttpException+  , throwIOException+  , expect+  , assert+  , catchError+  , catchJsonError+  , catchHttpException+  , catchIOException+  , parseJson+  , lookupKeyJson+  , constructFromJson+  , httpGet+  , httpSilentGet+  , httpPost+  , httpSilentPost+  , httpDelete+  , httpSilentDelete+  , hPutStrLn+  , hPutStrLnBlocking+  , readFilePath+  , writeFilePath+  , fileExists++  -- * Types+  , Http.E(..)+  , Http.JsonError(..)+  , WDError(..)+  , Http.R(..)+  , Http.LogOptions(..)+  , WDEnv(..)+  , ResponseFormat(..)+  , ApiVersion(..)+  , Outcome(..)+  , Http.Url+  , Http.HttpResponse(..)+  , WDLog(..)+  , Http.P(..)+  , WDAct(..)+  , Http.S(..)+  , WDState(..)++  -- * Logs+  , getAssertions+  , Http.logEntries+) where++++import Prelude hiding (readFile, writeFile)++import Control.Concurrent.MVar+  ( MVar )+import Control.Exception+  ( IOException, try )+import Control.Lens+  ( (^.), (^?) )+import Control.Monad+  ( ap )+import Data.Aeson+  ( Value(), Result(Success), toJSON, (.=), FromJSON, fromJSON, object )+import Data.Aeson.Encode.Pretty+  ( encodePretty )+import Data.Aeson.Lens+  ( key, _Value, _String )+import qualified Data.ByteString.Char8 as SC+  ( unpack )+import Data.ByteString.Lazy+  ( ByteString, readFile, writeFile )+import qualified Data.ByteString.Lazy.Char8 as LC+  ( unpack, pack )+import Data.Functor.Identity+  ( Identity(..) )+import Data.IORef+  ( IORef, newIORef, readIORef, writeIORef )+import qualified Data.Map.Strict as M+  ( Map, fromList )+import Data.Text+  ( pack, unpack, Text )+import qualified Network.HTTP.Client as N+  ( HttpException(..), HttpExceptionContent(..) )+import Network.Wreq+  ( Status, statusMessage, statusCode, responseStatus, defaults )+import System.Directory+  ( doesFileExist )+import System.IO+  ( Handle, hGetLine, hSetEcho, hGetEcho, hFlush, stdout, stdin )+import System.IO.Error+  ( eofErrorType, doesNotExistErrorType, mkIOError )+import Test.QuickCheck+  ( Property )++import qualified Control.Monad.Script.Http as Http+import qualified Data.MockIO as Mock+import qualified Data.MockIO.FileSystem as FS++import Web.Api.WebDriver.Types+import Web.Api.WebDriver.Assert++++++-- | Wrapper type around `Http.HttpT`; a stack of error, reader, writer, state, and prompt monads.+newtype WebDriverT m a = WDT+  { unWDT :: Http.HttpT WDError WDEnv WDLog WDState WDAct m a }++instance Functor (WebDriverT m) where+  fmap f = WDT . fmap f . unWDT++instance Applicative (WebDriverT m) where+  pure = return+  (<*>) = ap++instance Monad (WebDriverT m) where+  return = WDT . return+  (WDT x) >>= f = WDT (x >>= (unWDT . f))++-- | Lift a value from the inner monad+liftWebDriverT :: (Monad m) => m a -> WebDriverT m a+liftWebDriverT = WDT . Http.liftHttpT++-- | Type representing configuration settings for a WebDriver session+data WebDriverConfig eff = WDConfig+  { _initialState :: Http.S WDState+  , _environment :: Http.R WDError WDLog WDEnv+  , _evaluator :: forall a. Http.P WDAct a -> eff a+  }++-- | Default `IO` effects+defaultWebDriverConfig :: WebDriverConfig IO+defaultWebDriverConfig = WDConfig+  { _initialState = defaultWebDriverState+  , _environment = defaultWebDriverEnvironment+  , _evaluator = Http.evalIO evalWDAct+  }++defaultWebDriverState :: Http.S WDState+defaultWebDriverState = Http.S+  { Http._httpOptions = defaults+  , Http._httpSession = Nothing+  , Http._userState = WDState+    { _sessionId = Nothing+    }+  }++defaultWebDriverEnvironment :: Http.R WDError WDLog WDEnv+defaultWebDriverEnvironment = Http.R+  { Http._logHandle = stdout+  , Http._logLock = Nothing+  , Http._uid = ""+  , Http._logOptions = defaultWebDriverLogOptions+  , Http._httpErrorInject = promoteHttpResponseError+  , Http._env = defaultWDEnv+  }++-- | Uses default geckodriver settings+defaultWDEnv :: WDEnv+defaultWDEnv = WDEnv+  { _remoteHostname = "localhost"+  , _remotePort = 4444+  , _remotePath = ""+  , _dataPath = ""+  , _responseFormat = SpecFormat+  , _apiVersion = CR_2018_03_04+  , _stdin = stdin+  , _stdout = stdout+  }++-- | Noisy, JSON, in color, without headers.+defaultWebDriverLogOptions :: Http.LogOptions WDError WDLog+defaultWebDriverLogOptions = Http.trivialLogOptions+  { Http._logColor = True+  , Http._logJson = True+  , Http._logHeaders = False+  , Http._logSilent = False+  , Http._printUserError = printWDError+  , Http._printUserLog = printWDLog+  }++++-- | Execute a `WebDriverT` session.+execWebDriverT+  :: (Monad eff, Monad (m eff))+  => WebDriverConfig eff+  -> (forall u. eff u -> m eff u) -- ^ Lift effects to the inner monad+  -> WebDriverT (m eff) a+  -> m eff (Either (Http.E WDError) a, Http.S WDState, Http.W WDError WDLog)+execWebDriverT config lift = Http.execHttpTM+  (_initialState config) (_environment config) (_evaluator config) lift . unWDT++-- | Execute a `WebDriverT` session, returning an assertion summary with the result.+debugWebDriverT+  :: (Monad eff, Monad (m eff))+  => WebDriverConfig eff+  -> (forall u. eff u -> m eff u) -- ^ Lift effects to the inner monad+  -> WebDriverT (m eff) a+  -> m eff (Either String a, AssertionSummary)+debugWebDriverT config lift session = do+  (result, _, w) <- execWebDriverT config lift session+  let output = case result of+        Right a -> Right a+        Left e -> Left $ Http.printError (printWDError True) e+  return (output, summarize $ getAssertions $ Http.logEntries w)++-- | For testing with QuickCheck.+checkWebDriverT+  :: (Monad eff, Monad (m eff))+  => WebDriverConfig eff+  -> (forall u. eff u -> m eff u) -- ^ Lift effects to the inner monad+  -> (m eff (Either (Http.E WDError) t, Http.S WDState, Http.W WDError WDLog) -> IO q) -- ^ Condense to `IO`+  -> (q -> Bool) -- ^ Result check+  -> WebDriverT (m eff) t+  -> Property+checkWebDriverT config lift cond check =+  Http.checkHttpTM+    (_initialState config)+    (_environment config)+    (_evaluator config)+    lift cond check . unWDT++++++-- | `WebDriverT` over `IdentityT`.+type WebDriver eff a = WebDriverT (IdentityT eff) a++-- | The identity monad transformer.+newtype IdentityT m a = IdentityT { runIdentityT :: m a }++instance (Monad m) => Monad (IdentityT m) where+  return = IdentityT . return+  x >>= f = IdentityT $ runIdentityT x >>= (runIdentityT . f)++instance (Functor m) => Functor (IdentityT m) where+  fmap f = IdentityT . fmap f . runIdentityT++instance (Monad m) => Applicative (IdentityT m) where+  pure = return+  (<*>) = ap++++-- | Execute a `WebDriver` session.+execWebDriver+  :: (Monad eff)+  => WebDriverConfig eff+  -> WebDriver eff a+  -> eff (Either (Http.E WDError) a, Http.S WDState, Http.W WDError WDLog)+execWebDriver config = runIdentityT . execWebDriverT config IdentityT++-- | Execute a `WebDriver` session, returning an assertion summary with the result.+debugWebDriver+  :: (Monad eff)+  => WebDriverConfig eff+  -> WebDriver eff a+  -> eff (Either String a, AssertionSummary)+debugWebDriver config session = do+  (result, _, w) <- execWebDriver config session+  let output = case result of+        Right a -> Right a+        Left e -> Left $ Http.printError (printWDError True) e+  return (output, summarize $ getAssertions $ Http.logEntries w)++-- | For testing with QuickCheck+checkWebDriver+  :: (Monad eff)+  => WebDriverConfig eff+  -> (eff (Either (Http.E WDError) t, Http.S WDState, Http.W WDError WDLog) -> IO q) -- ^ Condense to `IO`+  -> (q -> Bool) -- ^ Result check+  -> WebDriver eff t+  -> Property+checkWebDriver config cond = checkWebDriverT config IdentityT (cond . runIdentityT)++++-- | Get a computed value from the state+fromState :: (Http.S WDState -> a) -> WebDriverT m a+fromState = WDT . Http.gets++-- | Mutate the state+modifyState :: (Http.S WDState -> Http.S WDState) -> WebDriverT m ()+modifyState = WDT . Http.modify++-- | Get a computed value from the environment+fromEnv :: (Http.R WDError WDLog WDEnv -> a) -> WebDriverT m a+fromEnv = WDT . Http.reader++logEntry :: WDLog -> WebDriverT m ()+logEntry = WDT . Http.logEntry++-- | Write a comment to the log.+comment :: String -> WebDriverT m ()+comment = WDT . Http.comment++-- | In milliseconds+wait :: Int -> WebDriverT m ()+wait = WDT . Http.wait++throwError :: WDError -> WebDriverT m a+throwError = WDT . Http.throwError++throwJsonError :: Http.JsonError -> WebDriverT m a+throwJsonError = WDT . Http.throwJsonError++throwHttpException :: N.HttpException -> WebDriverT m a+throwHttpException = WDT . Http.throwHttpException++throwIOException :: IOException -> WebDriverT m a+throwIOException = WDT . Http.throwIOException++-- | Rethrows other error types+catchError :: WebDriverT m a -> (WDError -> WebDriverT m a) -> WebDriverT m a+catchError x h = WDT $ Http.catchError (unWDT x) (unWDT . h)++-- | Rethrows other error types+catchJsonError :: WebDriverT m a -> (Http.JsonError -> WebDriverT m a) -> WebDriverT m a+catchJsonError x h = WDT $ Http.catchJsonError (unWDT x) (unWDT . h)++-- | Rethrows other error types+catchHttpException :: WebDriverT m a -> (N.HttpException -> WebDriverT m a) -> WebDriverT m a+catchHttpException x h = WDT $ Http.catchHttpException (unWDT x) (unWDT . h)++-- | Rethrows other error types+catchIOException :: WebDriverT m a -> (IOException -> WebDriverT m a) -> WebDriverT m a+catchIOException x h = WDT $ Http.catchIOException (unWDT x) (unWDT . h)++-- | May throw a `JsonError`.+parseJson :: ByteString -> WebDriverT m Value+parseJson = WDT . Http.parseJson++-- | May throw a `JsonError`.+lookupKeyJson :: Text -> Value -> WebDriverT m Value+lookupKeyJson key = WDT . Http.lookupKeyJson key++-- | May throw a `JsonError`.+constructFromJson :: (FromJSON a) => Value -> WebDriverT m a+constructFromJson = WDT . Http.constructFromJson++-- | Capures `HttpException`s.+httpGet :: Http.Url -> WebDriverT m Http.HttpResponse+httpGet = WDT . Http.httpGet++-- | Does not write request or response info to the log, except to note that a request occurred. Capures `HttpException`s.+httpSilentGet :: Http.Url -> WebDriverT m Http.HttpResponse+httpSilentGet = WDT . Http.httpSilentGet++-- | Capures `HttpException`s.+httpPost :: Http.Url -> ByteString -> WebDriverT m Http.HttpResponse+httpPost url = WDT . Http.httpPost url++-- | Does not write request or response info to the log, except to note that a request occurred. Capures `HttpException`s.+httpSilentPost :: Http.Url -> ByteString -> WebDriverT m Http.HttpResponse+httpSilentPost url = WDT . Http.httpSilentPost url++-- | Capures `HttpException`s.+httpDelete :: Http.Url -> WebDriverT m Http.HttpResponse+httpDelete = WDT . Http.httpDelete++-- | Does not write request or response info to the log, except to note that a request occurred. Capures `HttpException`s.+httpSilentDelete :: Http.Url -> WebDriverT m Http.HttpResponse+httpSilentDelete = WDT . Http.httpSilentDelete++-- | Capures `IOException`s.+hPutStrLn :: Handle -> String -> WebDriverT m ()+hPutStrLn h = WDT . Http.hPutStrLn h++-- | Capures `IOException`s.+hPutStrLnBlocking :: MVar () -> Handle -> String -> WebDriverT m ()+hPutStrLnBlocking lock h = WDT . Http.hPutStrLnBlocking lock h++promptWDAct :: WDAct a -> WebDriverT m a+promptWDAct = WDT . Http.prompt . Http.P++++instance Assert (WebDriverT m) where+  assert = logEntry . LogAssertion++++++-- | Filter the assertions from a `WebDriver` log.+getAssertions :: [WDLog] -> [Assertion]+getAssertions xs = get xs+  where+    get [] = []+    get (w:ws) = case w of+      LogAssertion a -> a : get ws+      _ -> get ws++++-- | Errors specific to WebDriver sessions.+data WDError+  = NoSession++  -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#handling-errors>+  | ResponseError ResponseErrorCode String String (Maybe Value) Status++  | UnableToConnect+  | RemoteEndTimeout+  | UnhandledHttpException N.HttpException+  | ImageDecodeError String+  | UnexpectedValue String+  | UnexpectedResult Outcome String+  deriving Show++-- | Read-only environment variables specific to WebDriver.+data WDEnv = WDEnv+  { -- | Hostname of the remote WebDriver server+    _remoteHostname :: String++    -- | Port of the remote WebDriver server+  , _remotePort :: Int++    -- | Extra path for the remote WebDriver server+  , _remotePath :: String++    -- | Path where secret data is stored+  , _dataPath :: FilePath++    -- | Flag for the format of HTTP responses from the remote end. Needed because not all remote ends are spec-compliant.+  , _responseFormat :: ResponseFormat++    -- | Version of the WebDriver specification.+  , _apiVersion :: ApiVersion++  , _stdin :: Handle+  , _stdout :: Handle+  }++-- | Version of the WebDriver specification.+data ApiVersion+  = CR_2018_03_04 -- ^ Candidate Recommendation, March 4, 2018+  deriving (Eq, Show)++-- | Format flag for HTTP responses from the remote end. Chromedriver, for instance, is not spec-compliant. :)+data ResponseFormat+  = SpecFormat -- ^ Responses as described in the spec.+  | ChromeFormat -- ^ Responses as emitted by chromedriver.+  deriving (Eq, Show)++-- | Includes a @Maybe String@ representing the current session ID, if one has been opened.+newtype WDState = WDState+  { _sessionId :: Maybe String+  } deriving Show++-- | WebDriver specific log entries.+data WDLog+  = LogAssertion Assertion+  | LogSession SessionVerb+  | LogUnexpectedResult Outcome String+  deriving Show++-- | Pretty printer for log entries.+printWDLog :: Bool -> WDLog -> String+printWDLog _ w = show w++-- | Type representing an abstract outcome. Do with it what you will.+data Outcome = IsSuccess | IsFailure+  deriving (Eq, Show)++-- | Representation of the actions we can perform on a `Session` (in the @wreq@ sense).+data SessionVerb+  = Close | Open+  deriving (Eq, Show)++-- | WebDriver specific effects+data WDAct a where+  ReadFilePath :: FilePath -> WDAct (Either IOException ByteString)+  WriteFilePath :: FilePath -> ByteString -> WDAct (Either IOException ())+  FileExists :: FilePath -> WDAct (Either IOException Bool)++  HGetLine :: Handle -> WDAct (Either IOException String)+  HGetLineNoEcho :: Handle -> WDAct (Either IOException String)++++-- | For validating responses. Throws an `UnexpectedValue` error if the two arguments are not equal according to their `Eq` instance.+expect+  :: (Monad m, Eq a, Show a)+  => a+  -> a+  -> WebDriverT m a+expect x y = if x == y+  then return y+  else throwError $ UnexpectedValue $+    "expected " ++ show x ++ " but got " ++ show y++-- | Promote semantic HTTP exceptions to typed errors.+promoteHttpResponseError :: N.HttpException -> Maybe WDError+promoteHttpResponseError e = case e of+  N.HttpExceptionRequest _ (N.StatusCodeException s r) -> do+    err <- r ^? key "value" . key "error" . _Value+    code <- case fromJSON err of+      Success m -> return m+      _ -> Nothing+    msg <- fmap unpack (r ^? key "value" . key "message" . _String)+    str <- fmap unpack (r ^? key "value" . key "stacktrace" . _String)+    let obj = r ^? key "value" . key "data" . _Value+    status <- s ^? responseStatus+    return $ ResponseError code msg str obj status++  N.HttpExceptionRequest _ (N.ConnectionFailure _) -> Just UnableToConnect++  N.HttpExceptionRequest _ N.ConnectionTimeout -> Just RemoteEndTimeout++  _ -> Just $ UnhandledHttpException e++-- | For pretty printing.+printWDError :: Bool -> WDError -> String+printWDError json e = case e of+  NoSession -> "No session in progress"+  ResponseError code msg trace obj status ->+    let+      code = status ^. statusCode+      smsg = status ^. statusMessage+    in+      (("Response: " ++ show code ++ " " ++ SC.unpack smsg ++ "\n") ++) $+      LC.unpack $ encodePretty $ object+        [ "error" .= toJSON code+        , "message" .= toJSON msg+        , "stacktrace" .= toJSON trace+        , "data" .= (toJSON <$> obj)+        ]+  UnableToConnect -> "Unable to connect to WebDriver server"+  RemoteEndTimeout -> "Remote End Timeout"+  UnhandledHttpException e -> "Unhandled HTTP Exception: " ++ show e+  ImageDecodeError msg -> "Image decode: " ++ msg+  UnexpectedValue msg -> "Unexpected value: " ++ msg+  UnexpectedResult r msg -> case r of+    IsSuccess -> "Unexpected success: " ++ msg+    IsFailure -> "Unexpected failure: " ++ msg++-- | Prompt for input on `stdin`.+promptForString+  :: (Monad m)+  => String -- ^ Prompt text+  -> WebDriverT m String+promptForString prompt = do+  outH <- fromEnv (_stdout . Http._env)+  inH <- fromEnv (_stdin . Http._env)+  hPutStrLn outH prompt+  result <- promptWDAct $ HGetLine inH+  case result of+    Right string -> return string+    Left e -> throwIOException e++-- | Prompt for input on `stdin`, but do not echo the typed characters back to the terminal -- handy for getting suuper secret info.+promptForSecret+  :: (Monad m)+  => String -- ^ Prompt text+  -> WebDriverT m String+promptForSecret prompt = do+  outH <- fromEnv (_stdout . Http._env)+  inH <- fromEnv (_stdin . Http._env)+  hPutStrLn outH prompt+  result <- promptWDAct $ HGetLineNoEcho inH+  case result of+    Right string -> return string+    Left e -> throwIOException e++-- | Captures `IOException`s+readFilePath+  :: (Monad m)+  => FilePath+  -> WebDriverT m ByteString+readFilePath path = do+  result <- promptWDAct $ ReadFilePath path+  case result of+    Right bytes -> return bytes+    Left e -> throwIOException e++-- | Captures `IOException`s+writeFilePath+  :: (Monad m)+  => FilePath+  -> ByteString+  -> WebDriverT m ()+writeFilePath path bytes = do+  result <- promptWDAct $ WriteFilePath path bytes+  case result of+    Right () -> return ()+    Left e -> throwIOException e++-- | Captures `IOException`s+fileExists+  :: (Monad m)+  => FilePath+  -> WebDriverT m Bool+fileExists path = do+  result <- promptWDAct $ FileExists path+  case result of+    Right p -> return p+    Left e -> throwIOException e++++-- | Standard `IO` evaluator for `WDAct`.+evalWDAct :: WDAct a -> IO a+evalWDAct act = case act of+  ReadFilePath path -> try $ readFile path+  WriteFilePath path bytes -> try $ writeFile path bytes+  FileExists path -> try $ doesFileExist path++  HGetLine handle -> try $ do+    hFlush handle+    hGetLine handle++  HGetLineNoEcho handle -> try $ do+    hFlush handle+    echo <- hGetEcho handle+    hSetEcho handle False+    secret <- hGetLine handle+    hSetEcho handle echo+    return secret++++-- | Standard `Mock.MockIO` evaluator for `WDAct`.+evalWDActMockIO :: WDAct a -> Mock.MockIO u a+evalWDActMockIO act = case act of+  ReadFilePath path -> do+    Mock.incrementTimer 1+    world <- Mock.getMockWorld+    let result = FS.getLines (Left path) $ Mock._files world+    case result of+      Nothing -> do+        return $ Left $ mkIOError doesNotExistErrorType "" Nothing (Just path)+      Just lns -> return $ Right $ LC.pack $ unlines lns++  WriteFilePath path bytes -> do+    Mock.incrementTimer 1+    fmap Right $ Mock.modifyMockWorld $ \w -> w+      { Mock._files = FS.writeLines (Left path) [LC.unpack bytes] $ Mock._files w }++  FileExists path -> do+    Mock.incrementTimer 1+    world <- Mock.getMockWorld+    return $ Right $ FS.fileExists (Left path) $ Mock._files world++  HGetLine handle -> do+    Mock.incrementTimer 1+    world <- Mock.getMockWorld+    let dne = mkIOError doesNotExistErrorType "" (Just handle) Nothing+    let eof = mkIOError eofErrorType "" (Just handle) Nothing+    let result = FS.readLine dne eof (Right handle) $ Mock._files world+    case result of+      Left err -> return $ Left err+      Right (str, fs) -> do+        Mock.modifyMockWorld $ \w -> w { Mock._files = fs }+        return $ Right str++  HGetLineNoEcho handle -> do+    Mock.incrementTimer 1+    world <- Mock.getMockWorld+    let dne = mkIOError doesNotExistErrorType "" (Just handle) Nothing+    let eof = mkIOError eofErrorType "" (Just handle) Nothing+    let result = FS.readLine dne eof (Right handle) $ Mock._files world+    case result of+      Left err -> return $ Left err+      Right (str, fs) -> do+        Mock.modifyMockWorld $ \w -> w { Mock._files = fs }+        return $ Right str
+ src/Web/Api/WebDriver/Types.hs view
@@ -0,0 +1,1136 @@+{- |+Module      : Web.Api.WebDriver.Types+Description : Typed arguments for WebDriver endpoints.+Copyright   : 2018, Automattic, Inc.+License     : GPL-3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX++The WebDriver protocol involves passing several different kinds of JSON objects. We can encode these as /types/ to make our DSL more robust; this module is a grab bag of these types. For each one we need `ToJSON` and `FromJSON` instances, and sometimes also a default value.++Note that while the WebDriver spec defines some JSON objects, in general a given WebDriver server can accept additional properties on any given object. Our types here will be limited to the "spec" object signatures, but our API will need to be user extensible.+-}++{-# LANGUAGE OverloadedStrings, RecordWildCards, BangPatterns #-}+module Web.Api.WebDriver.Types (+  -- * Stringy Types+    SessionId+  , ElementRef(..)+  , ContextId(..)+  , Selector+  , AttributeName+  , PropertyName+  , Script+  , CookieName+  , CssPropertyName++  , FrameReference(..)++  -- * Capabilities+  , Capabilities(..)+  , BrowserName(..)+  , PlatformName(..)+  , emptyCapabilities+  , defaultFirefoxCapabilities+  , headlessFirefoxCapabilities+  , defaultChromeCapabilities+  , LogLevel(..)+  , FirefoxOptions(..)+  , FirefoxLog(..)+  , defaultFirefoxOptions+  , ChromeOptions(..)+  , defaultChromeOptions++  -- * Proxy+  , ProxyConfig(..)+  , emptyProxyConfig+  , ProxyType(..)+  , HostAndOptionalPort(..)++  -- * Timeout+  , TimeoutConfig(..)+  , emptyTimeoutConfig++  -- * Input and Actions+  , InputSource(..)+  , PointerSubtype(..)+  , InputSourceParameter(..)+  , Action(..)+  , emptyAction+  , ActionType(..)+  , ActionItem(..)+  , emptyActionItem++  -- * Misc+  , LocationStrategy(..)+  , Rect(..)+  , emptyRect+  , PromptHandler(..)+  , Cookie(..)+  , emptyCookie++  -- * Error Responses+  , ResponseErrorCode(..)+  ) where++import Data.Char+  ( toLower )+import Data.Maybe+  ( catMaybes )+import Data.Scientific+  ( Scientific, scientific )+import Data.String+  ( IsString(..) )+import Data.Aeson.Types+  ( ToJSON(..), FromJSON(..), Value(..), KeyValue+  , Pair, (.:?), (.:), (.=), object, typeMismatch )+import Data.Text+  ( Text, pack, unpack )+import Test.QuickCheck+  ( Arbitrary(..), arbitraryBoundedEnum, Gen )+import Test.QuickCheck.Gen+  ( listOf, oneof )++import Web.Api.WebDriver.Uri+import Web.Api.WebDriver.Types.Keyboard++++unrecognizedValue :: (Monad m) => String -> Text -> m a+unrecognizedValue !name !string = fail $+  "Unrecognized value for type " ++ name ++ ": " ++ unpack string++malformedValue :: (Monad m) => String -> String -> m a+malformedValue !name !value = fail $+  "Malformed value for type" ++ name ++ ": " ++ value++++object_ :: [Maybe Pair] -> Value+object_ = object . filter (\(_, v) -> v /= Null) . catMaybes++(.==) :: (ToJSON v, KeyValue kv) => Text -> v -> Maybe kv+(.==) key value = Just (key .= value)++(.=?) :: (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv+(.=?) key = fmap (key .=)++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-session-id>.+type SessionId = String++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-web-element-reference>.+newtype ElementRef = ElementRef+  { theElementRef :: String+  } deriving Eq++instance Show ElementRef where+  show (ElementRef str) = str++instance IsString ElementRef where+  fromString = ElementRef++-- | Identifier for a /browsing context/; see <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-current-browsing-context>.+newtype ContextId = ContextId+  { theContextId :: String+  } deriving Eq++instance Show ContextId where+  show (ContextId str) = str++instance IsString ContextId where+  fromString = ContextId++-- | For use with a /Locator Strategy/. See <https://w3c.github.io/webdriver/webdriver-spec.html#locator-strategies>.+type Selector = String++-- | Used with `getElementAttribute`.+type AttributeName = String++-- | Used with `getElementProperty`.+type PropertyName = String++-- | Javascript+type Script = String++-- | Used with `getNamedCookie`.+type CookieName = String++-- | Used with `getElementCssValue`.+type CssPropertyName = String++-- | Possible frame references; see <https://w3c.github.io/webdriver/webdriver-spec.html#switch-to-frame>.+data FrameReference+  = TopLevelFrame+  | FrameNumber Int+  | FrameContainingElement ElementRef+  deriving (Eq, Show)++++-- | Semantic HTTP error responses. See <https://w3c.github.io/webdriver/webdriver-spec.html#locator-strategies>.+data ResponseErrorCode+  = ElementClickIntercepted+  | ElementNotSelectable+  | ElementNotInteractable+  | InsecureCertificate+  | InvalidArgument+  | InvalidCookieDomain+  | InvalidCoordinates+  | InvalidElementState+  | InvalidSelector+  | InvalidSessionId+  | JavaScriptError+  | MoveTargetOutOfBounds+  | NoSuchAlert+  | NoSuchCookie+  | NoSuchElement+  | NoSuchFrame+  | NoSuchWindow+  | ScriptTimeout+  | SessionNotCreated+  | StaleElementReference+  | Timeout+  | UnableToSetCookie+  | UnableToCaptureScreen+  | UnexpectedAlertOpen+  | UnknownCommand+  | UnknownError+  | UnknownMethod+  | UnsupportedOperation++  -- | Just in case!+  | UnhandledErrorCode Text+  deriving (Eq, Show)++instance FromJSON ResponseErrorCode where+  parseJSON (String x) = case x of+    "element click intercepted" -> return ElementClickIntercepted+    "element not selectable" -> return ElementNotSelectable+    "element not interactable" -> return ElementNotInteractable+    "insecure certificate" -> return InsecureCertificate+    "invalid argument" -> return InvalidArgument+    "invalid cookie domain" -> return InvalidCookieDomain+    "invalid coordinates" -> return InvalidCoordinates+    "invalid element state" -> return InvalidElementState+    "invalid selector" -> return InvalidSelector+    "invalid session id" -> return InvalidSessionId+    "javascript error" -> return JavaScriptError+    "move target out of bounds" -> return MoveTargetOutOfBounds+    "no such alert" -> return NoSuchAlert+    "no such cookie" -> return NoSuchCookie+    "no such element" -> return NoSuchElement+    "no such frame" -> return NoSuchFrame+    "no such window" -> return NoSuchWindow+    "script timeout" -> return ScriptTimeout+    "session not created" -> return SessionNotCreated+    "stale element reference" -> return StaleElementReference+    "timeout" -> return Timeout+    "unable to set cookie" -> return UnableToSetCookie+    "unable to capture screen" -> return UnableToCaptureScreen+    "unexpected alert open" -> return UnexpectedAlertOpen+    "unknown command" -> return UnknownCommand+    "unknown error" -> return UnknownError+    "unknown method" -> return UnknownMethod+    "unsupported operation" -> return UnsupportedOperation+    text -> return $ UnhandledErrorCode text+  parseJSON invalid = typeMismatch "ResponseErrorCode" invalid++instance ToJSON ResponseErrorCode where+  toJSON x = case x of+    ElementClickIntercepted -> String "element click intercepted"+    ElementNotSelectable -> String "element not selectable"+    ElementNotInteractable -> String "element not interactable"+    InsecureCertificate -> String "insecure certificate"+    InvalidArgument -> String "invalid argument"+    InvalidCookieDomain -> String "invalid cookie domain"+    InvalidCoordinates -> String "invalid coordinates"+    InvalidElementState -> String "invalid element state"+    InvalidSelector -> String "invalid selector"+    InvalidSessionId -> String "invalid session id"+    JavaScriptError -> String "javascript error"+    MoveTargetOutOfBounds -> String "move target out of bounds"+    NoSuchAlert -> String "no such alert"+    NoSuchCookie -> String "no such cookie"+    NoSuchElement -> String "no such element"+    NoSuchFrame -> String "no such frame"+    NoSuchWindow -> String "no such window"+    ScriptTimeout -> String "script timeout"+    SessionNotCreated -> String "session not created"+    StaleElementReference -> String "stale element reference"+    Timeout -> String "timeout"+    UnableToSetCookie -> String "unable to set cookie"+    UnableToCaptureScreen -> String "unable to capture screen"+    UnexpectedAlertOpen -> String "unexpected alert open"+    UnknownCommand -> String "unknown command"+    UnknownError -> String "unknown error"+    UnknownMethod -> String "unknown method"+    UnsupportedOperation -> String "unsupported operation"+    UnhandledErrorCode msg -> String msg++instance Arbitrary ResponseErrorCode where+  arbitrary = oneof $ map return+    [ ElementClickIntercepted+    , ElementNotSelectable+    , ElementNotInteractable+    , InsecureCertificate+    , InvalidArgument+    , InvalidCookieDomain+    , InvalidCoordinates+    , InvalidElementState+    , InvalidSelector+    , InvalidSessionId+    , JavaScriptError+    , MoveTargetOutOfBounds+    , NoSuchAlert+    , NoSuchCookie+    , NoSuchElement+    , NoSuchFrame+    , NoSuchWindow+    , ScriptTimeout+    , SessionNotCreated+    , StaleElementReference+    , Timeout+    , UnableToSetCookie+    , UnableToCaptureScreen+    , UnexpectedAlertOpen+    , UnknownCommand+    , UnknownError+    , UnknownMethod+    , UnsupportedOperation+    ]++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#capabilities>.+data Capabilities = Capabilities+  { _browserName :: Maybe BrowserName -- ^ @browserName@+  , _browserVersion :: Maybe String -- ^ @browserVersion@+  , _platformName :: Maybe PlatformName -- ^ @platformName@+  , _acceptInsecureCerts :: Maybe Bool -- ^ @acceptInsecureCerts@+  , _pageLoadStrategy :: Maybe String -- ^ @pageLoadStrategy@+  , _proxy :: Maybe ProxyConfig -- ^ @proxy@+  , _setWindowRect :: Maybe Bool -- ^ @setWindowRect@+  , _timeouts :: Maybe TimeoutConfig -- ^ @timeouts@+  , _unhandledPromptBehavior :: Maybe PromptHandler -- ^ @unhandledPromptBehavior@++  -- | Optional extension, but very common.+  , _chromeOptions :: Maybe ChromeOptions -- ^ @chromeOptions@++  -- | Optional extension, but very common.+  , _firefoxOptions :: Maybe FirefoxOptions -- ^ @moz:firefoxOptions@+  } deriving (Eq, Show)++instance FromJSON Capabilities where+  parseJSON (Object v) = Capabilities+    <$> v .:? "browserName"+    <*> v .:? "browserVersion"+    <*> v .:? "platformName"+    <*> v .:? "acceptInsecureCerts"+    <*> v .:? "pageLoadStrategy"+    <*> v .:? "proxy"+    <*> v .:? "setWindowRect"+    <*> v .:? "timeouts"+    <*> v .:? "unhandledPromptBehavior"+    <*> v .:? "chromeOptions"+    <*> v .:? "moz:firefoxOptions"+  parseJSON invalid = typeMismatch "Capabilities" invalid++instance ToJSON Capabilities where+  toJSON Capabilities{..} = object_+    [ "browserName" .=? (toJSON <$> _browserName)+    , "browserVersion" .=? (toJSON <$> _browserVersion)+    , "platformName" .=? (toJSON <$> _platformName)+    , "acceptInsecureCerts" .=? (toJSON <$> _acceptInsecureCerts)+    , "pageLoadStrategy" .=? (toJSON <$> _pageLoadStrategy)+    , "proxy" .=? (toJSON <$> _proxy)+    , "setWindowRect" .=? (toJSON <$> _setWindowRect)+    , "timeouts" .=? (toJSON <$> _timeouts)+    , "unhandledPromptBehavior" .=? (toJSON <$> _unhandledPromptBehavior)+    , "chromeOptions" .=? (toJSON <$> _chromeOptions)+    , "moz:firefoxOptions" .=? (toJSON <$> _firefoxOptions)+    ]++instance Arbitrary Capabilities where+  arbitrary = Capabilities+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++-- | `Capabilities` with all members set to `Nothing`.+emptyCapabilities :: Capabilities+emptyCapabilities = Capabilities+  { _browserName = Nothing+  , _browserVersion = Nothing+  , _platformName = Nothing+  , _acceptInsecureCerts = Nothing+  , _pageLoadStrategy = Nothing+  , _proxy = Nothing+  , _setWindowRect = Nothing+  , _timeouts = Nothing+  , _unhandledPromptBehavior = Nothing+  , _chromeOptions = Nothing+  , _firefoxOptions = Nothing+  }++-- | All members set to `Nothing` except `_browserName`, which is @Just Firefox@.+defaultFirefoxCapabilities :: Capabilities+defaultFirefoxCapabilities = emptyCapabilities+  { _browserName = Just Firefox+  }++-- | Passing the "-headless" parameter to Firefox.+headlessFirefoxCapabilities :: Capabilities+headlessFirefoxCapabilities = defaultFirefoxCapabilities+  { _firefoxOptions = Just $ defaultFirefoxOptions+    { _firefoxArgs = Just ["-headless"]+    }+  }++-- | All members set to `Nothing` except `_browserName`, which is @Just Chrome@.+defaultChromeCapabilities :: Capabilities+defaultChromeCapabilities = emptyCapabilities+  { _browserName = Just Chrome+  }++++-- | Used in `Capabilities`.+data BrowserName+  = Firefox+  | Chrome+  | Safari+  deriving (Eq, Show, Enum, Bounded)++instance FromJSON BrowserName where+  parseJSON (String x) = case x of+    "firefox" -> return Firefox+    "chrome" -> return Chrome+    "safari" -> return Safari+    _ -> unrecognizedValue "BrowserName" x+  parseJSON invalid = typeMismatch "BrowserName" invalid++instance ToJSON BrowserName where+  toJSON Firefox = String "firefox"+  toJSON Chrome = String "chrome"+  toJSON Safari = String "safari"++instance Arbitrary BrowserName where+  arbitrary = arbitraryBoundedEnum++++-- | Used in `Capabilities`.+data PlatformName+  = Mac+  deriving (Eq, Show, Enum, Bounded)++instance FromJSON PlatformName where+  parseJSON (String x) = case unpack x of+    "mac" -> return Mac+    _ -> unrecognizedValue "PlaformName" x+  parseJSON invalid = typeMismatch "PlatformName" invalid++instance ToJSON PlatformName where+  toJSON Mac = String "mac"++instance Arbitrary PlatformName where+  arbitrary = arbitraryBoundedEnum++++-- | See <https://sites.google.com/a/chromium.org/chromedriver/capabilities>.+data ChromeOptions = ChromeOptions+  { _chromeBinary :: Maybe FilePath -- ^ @binary@+  , _chromeArgs :: Maybe [String] -- ^ @args@+  } deriving (Eq, Show)++instance FromJSON ChromeOptions where+  parseJSON (Object v) = ChromeOptions+    <$> v .:? "binary"+    <*> v .:? "args"+  parseJSON invalid = typeMismatch "ChromeOptions" invalid++instance ToJSON ChromeOptions where+  toJSON ChromeOptions{..} = object_+    [ "binary" .=? (toJSON <$> _chromeBinary)+    , "args" .=? (toJSON <$> _chromeArgs)+    ]++instance Arbitrary ChromeOptions where+  arbitrary = ChromeOptions+    <$> arbitrary+    <*> arbitrary++-- | All members set to `Nothing`.+defaultChromeOptions :: ChromeOptions+defaultChromeOptions = ChromeOptions+  { _chromeBinary = Nothing+  , _chromeArgs = Nothing+  }++++-- | See <https://github.com/mozilla/geckodriver#firefox-capabilities>.+data FirefoxOptions = FirefoxOptions+  { _firefoxBinary :: Maybe FilePath -- ^ @binary@+  , _firefoxArgs :: Maybe [String] -- ^ @args@+  , _firefoxLog :: Maybe FirefoxLog+  } deriving (Eq, Show)++instance FromJSON FirefoxOptions where+  parseJSON (Object v) = FirefoxOptions+    <$> v .:? "binary"+    <*> v .:? "args"+    <*> v .:? "log"+  parseJSON invalid = typeMismatch "FirefoxOptions" invalid++instance ToJSON FirefoxOptions where+  toJSON FirefoxOptions{..} = object_+    [ "binary" .=? (toJSON <$> _firefoxBinary)+    , "args" .=? (toJSON <$> _firefoxArgs)+    , "log" .=? (toJSON <$> _firefoxLog)+    ]++instance Arbitrary FirefoxOptions where+  arbitrary = FirefoxOptions+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary++-- | All members set to `Nothing`.+defaultFirefoxOptions :: FirefoxOptions+defaultFirefoxOptions = FirefoxOptions+  { _firefoxBinary = Nothing+  , _firefoxArgs = Nothing+  , _firefoxLog = Nothing+  }++++-- | See <https://github.com/mozilla/geckodriver#log-object>.+newtype FirefoxLog = FirefoxLog+  { _firefoxLogLevel :: Maybe LogLevel+  } deriving (Eq, Show)++instance FromJSON FirefoxLog where+  parseJSON (Object v) = FirefoxLog+    <$> v .:? "level"+  parseJSON invalid = typeMismatch "FirefoxLog" invalid++instance ToJSON FirefoxLog where+  toJSON FirefoxLog{..} = object_+    [ "level" .=? (toJSON <$> _firefoxLogLevel)+    ]++instance Arbitrary FirefoxLog where+  arbitrary = FirefoxLog+    <$> arbitrary++++-- | See <https://github.com/mozilla/geckodriver#log-object>.+data LogLevel+  = LogTrace+  | LogDebug+  | LogConfig+  | LogInfo+  | LogWarn+  | LogError+  | LogFatal+  deriving (Eq, Show, Enum, Bounded)++instance FromJSON LogLevel where+  parseJSON (String x) = case x of+    "trace" -> return LogTrace+    "debug" -> return LogDebug+    "config" -> return LogConfig+    "info" -> return LogInfo+    "warn" -> return LogWarn+    "error" -> return LogError+    "fatal" -> return LogFatal+    _ -> unrecognizedValue "LogLevel" x+  parseJSON invalid = typeMismatch "LogLevel" invalid++instance ToJSON LogLevel where+  toJSON x = case x of+    LogTrace -> String "trace"+    LogDebug -> String "debug"+    LogConfig -> String "config"+    LogInfo -> String "info"+    LogWarn -> String "warn"+    LogError -> String "error"+    LogFatal -> String "fatal"++instance Arbitrary LogLevel where+  arbitrary = arbitraryBoundedEnum++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#proxy>.+data ProxyConfig = ProxyConfig+  { _proxyType :: Maybe ProxyType -- ^ @proxyType@+  , _proxyAutoconfigUrl :: Maybe String -- ^ @proxyAutoconfigUrl@+  , _ftpProxy :: Maybe HostAndOptionalPort -- ^ @ftpProxy@+  , _httpProxy :: Maybe HostAndOptionalPort -- ^ @httpProxy@+  , _noProxy :: Maybe [String] -- ^ @noProxy@+  , _sslProxy :: Maybe HostAndOptionalPort -- ^ @sslProxy@+  , _socksProxy :: Maybe HostAndOptionalPort -- ^ @socksProxy@+  , _socksVersion :: Maybe Int -- ^ @socksVersion@+  } deriving (Eq, Show)++instance FromJSON ProxyConfig where+  parseJSON (Object v) = ProxyConfig+    <$> v .:? "proxyType"+    <*> v .:? "proxyAutoconfigUrl"+    <*> v .:? "ftpProxy"+    <*> v .:? "httpProxy"+    <*> v .:? "noProxy"+    <*> v .:? "sslProxy"+    <*> v .:? "socksProxy"+    <*> v .:? "socksVersion"+  parseJSON invalid = typeMismatch "ProxyConfig" invalid++instance ToJSON ProxyConfig where+  toJSON ProxyConfig{..} = object_+    [ "proxyType" .=? (toJSON <$> _proxyType)+    , "proxyAutoconfigUrl" .=? (toJSON <$> _proxyAutoconfigUrl)+    , "ftpProxy" .=? (toJSON <$> _ftpProxy)+    , "httpProxy" .=? (toJSON <$> _httpProxy)+    , "noProxy" .=? (toJSON <$> _noProxy)+    , "sslProxy" .=? (toJSON <$> _sslProxy)+    , "socksProxy" .=? (toJSON <$> _socksProxy)+    , "socksVersion" .=? (toJSON <$> _socksVersion)+    ]++instance Arbitrary ProxyConfig where+  arbitrary = ProxyConfig+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++-- | `ProxyConfig` object with all members set to `Nothing`.+emptyProxyConfig :: ProxyConfig+emptyProxyConfig = ProxyConfig+  { _proxyType = Nothing+  , _proxyAutoconfigUrl = Nothing+  , _ftpProxy = Nothing+  , _httpProxy = Nothing+  , _noProxy = Nothing+  , _sslProxy = Nothing+  , _socksProxy = Nothing+  , _socksVersion = Nothing+  }++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-host-and-optional-port>.+data HostAndOptionalPort = HostAndOptionalPort+  { _urlHost :: Host+  , _urlPort :: Maybe Port+  } deriving (Eq, Show)++instance FromJSON HostAndOptionalPort where+  parseJSON (String x) =+    let string = unpack x in+    case span (/= ':') string of+      ("",_) -> malformedValue "Host" string+      (str,[]) -> case mkHost str of+        Nothing -> malformedValue "Host" string+        Just h -> return HostAndOptionalPort+          { _urlHost = h+          , _urlPort = Nothing+          }+      (str,":") -> malformedValue "Port" string+      (str,':':rest) -> case mkHost str of+        Nothing -> malformedValue "Host" string+        Just h -> case mkPort rest of+          Nothing -> malformedValue "Port" rest+          Just p -> return HostAndOptionalPort+            { _urlHost = h+            , _urlPort = Just p+            }+      (str,rest) -> malformedValue "Host" string+  parseJSON invalid = typeMismatch "HostAndOptionalPort" invalid++instance ToJSON HostAndOptionalPort where+  toJSON HostAndOptionalPort{..} = case _urlPort of+    Nothing -> String $ pack $ show _urlHost+    Just pt -> String $ pack $ concat [show _urlHost, ":", show pt]++instance Arbitrary HostAndOptionalPort where+  arbitrary = HostAndOptionalPort+    <$> arbitrary+    <*> arbitrary++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-proxytype>.+data ProxyType+  = ProxyPac -- ^ @pac@+  | ProxyDirect -- ^ @direct@+  | ProxyAutodetect -- ^ @autodetect@+  | ProxySystem -- ^ @system@+  | ProxyManual -- ^ @manual@+  deriving (Eq, Show, Enum, Bounded)++instance FromJSON ProxyType where+  parseJSON (String x) = case x of+    "pac" -> return ProxyPac+    "direct" -> return ProxyDirect+    "autodetect" -> return ProxyAutodetect+    "system" -> return ProxySystem+    "manual" -> return ProxyManual+    _ -> unrecognizedValue "ProxyType" x+  parseJSON invalid = typeMismatch "ProxyType" invalid++instance ToJSON ProxyType where+  toJSON x = case x of+    ProxyPac -> String "pac"+    ProxyDirect -> String "direct"+    ProxyAutodetect -> String "autodetect"+    ProxySystem -> String "system"+    ProxyManual -> String "manual"++instance Arbitrary ProxyType where+  arbitrary = arbitraryBoundedEnum++++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-timeouts>.+data TimeoutConfig = TimeoutConfig+  { _script :: Maybe Int -- ^ @script@+  , _pageLoad :: Maybe Int -- ^ @pageLoad@+  , _implicit :: Maybe Int -- ^ @implicit@+  } deriving (Eq, Show)++instance FromJSON TimeoutConfig where+  parseJSON (Object v) = TimeoutConfig+    <$> v .:? "script"+    <*> v .:? "pageLoad"+    <*> v .:? "implicit"+  parseJSON invalid = typeMismatch "TimeoutConfig" invalid++instance ToJSON TimeoutConfig where+  toJSON TimeoutConfig{..} = object_+    [ "script" .== (toJSON <$> _script)+    , "pageLoad" .== (toJSON <$> _pageLoad)+    , "implicit" .== (toJSON <$> _implicit)+    ]++instance Arbitrary TimeoutConfig where+  arbitrary = TimeoutConfig+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary++-- | `TimeoutConfig` object with all members set to `Nothing`.+emptyTimeoutConfig :: TimeoutConfig+emptyTimeoutConfig = TimeoutConfig+  { _script = Nothing+  , _pageLoad = Nothing+  , _implicit = Nothing+  }++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-table-of-location-strategies>.+data LocationStrategy+  = CssSelector -- ^ @css selector@+  | LinkTextSelector -- ^ @link text@+  | PartialLinkTextSelector -- ^ @partial link text@+  | TagName -- ^ @tag name@+  | XPathSelector -- ^ @xpath@+  deriving (Eq, Show, Enum, Bounded)++instance FromJSON LocationStrategy where+  parseJSON (String x) = case x of+    "css selector" -> return CssSelector+    "link text" -> return LinkTextSelector+    "partial link text" -> return PartialLinkTextSelector+    "tag name" -> return TagName+    "xpath" -> return XPathSelector+    _ -> unrecognizedValue "LocationStrategy" x+  parseJSON invalid = typeMismatch "LocationStrategy" invalid++instance ToJSON LocationStrategy where+  toJSON x = case x of+    CssSelector -> String "css selector"+    LinkTextSelector -> String "link text"+    PartialLinkTextSelector -> String "partial link text"+    TagName -> String "tag name"+    XPathSelector -> String "xpath"++instance Arbitrary LocationStrategy where+  arbitrary = arbitraryBoundedEnum++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-input-sources>.+data InputSource+  = NullInputSource -- ^ @null@+  | KeyInputSource -- ^ @key@+  | PointerInputSource -- ^ @pointer@+  deriving (Eq, Show, Enum, Bounded)++instance FromJSON InputSource where+  parseJSON (String x) = case x of+    "null" -> return NullInputSource+    "key" -> return KeyInputSource+    "pointer" -> return PointerInputSource+    _ -> unrecognizedValue "InputSource" x+  parseJSON invalid = typeMismatch "InputSource" invalid++instance ToJSON InputSource where+  toJSON x = case x of+    NullInputSource -> String "null"+    KeyInputSource -> String "key"+    PointerInputSource -> String "pointer"++instance Arbitrary InputSource where+  arbitrary = arbitraryBoundedEnum++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-pointer-input-state>.+data PointerSubtype+  = PointerMouse -- ^ @mouse@+  | PointerPen -- ^ @pen@+  | PointerTouch -- ^ @touch@+  deriving (Eq, Show, Enum, Bounded)++instance FromJSON PointerSubtype where+  parseJSON (String x) = case x of+    "mouse" -> return PointerMouse+    "pen" -> return PointerPen+    "touch" -> return PointerTouch+    _ -> unrecognizedValue "PointerSubtype" x+  parseJSON invalid = typeMismatch "PointerSubtype" invalid++instance ToJSON PointerSubtype where+  toJSON x = case x of +    PointerMouse -> String "mouse"+    PointerPen -> String "pen"+    PointerTouch -> String "touch"++instance Arbitrary PointerSubtype where+  arbitrary = arbitraryBoundedEnum++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#processing-actions-requests>.+data Action = Action+  { _inputSourceType :: Maybe InputSource -- ^ @type@+  , _inputSourceId :: Maybe String -- ^ @id@+  , _inputSourceParameters :: Maybe InputSourceParameter -- ^ @parameters@+  , _actionItems :: [ActionItem] -- ^ @actions@+  } deriving (Eq, Show)++instance FromJSON Action where+  parseJSON (Object v) = Action+    <$> v .:? "type"+    <*> v .:? "id"+    <*> v .:? "parameters"+    <*> v .:  "actions"+  parseJSON invalid = typeMismatch "Action" invalid++instance ToJSON Action where+  toJSON Action{..} = object_+    [ "type" .=? (toJSON <$> _inputSourceType)+    , "id" .=? (toJSON <$> _inputSourceId)+    , "parameters" .=? (toJSON <$> _inputSourceParameters)+    , "actions" .== (toJSON <$> _actionItems)+    ]++instance Arbitrary Action where+  arbitrary = Action+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++-- | All members set to `Nothing` except `_actionItems`, which is the empty list.+emptyAction = Action+  { _inputSourceType = Nothing+  , _inputSourceId = Nothing+  , _inputSourceParameters = Nothing+  , _actionItems = []+  }++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#terminology-0>.+data ActionType+  = PauseAction -- ^ @pause@+  | KeyUpAction -- ^ @keyUp@+  | KeyDownAction -- ^ @keyDown@+  | PointerDownAction -- ^ @pointerDown@+  | PointerUpAction -- ^ @pointerUp@+  | PointerMoveAction -- ^ @pointerMove@+  | PointerCancelAction -- ^ @pointerCancel@+  deriving (Eq, Show, Enum, Bounded)++instance FromJSON ActionType where+  parseJSON (String x) = case x of+    "pause" -> return PauseAction+    "keyUp" -> return KeyUpAction+    "keyDown" -> return KeyDownAction+    "pointerDown" -> return PointerDownAction+    "pointerUp" -> return PointerUpAction+    "pointerMove" -> return PointerMoveAction+    "pointerCancel" -> return PointerCancelAction+    _ -> unrecognizedValue "ActionType" x+  parseJSON invalid = typeMismatch "ActionType" invalid++instance ToJSON ActionType where+  toJSON x = case x of+    PauseAction -> String "pause"+    KeyUpAction -> String "keyUp"+    KeyDownAction -> String "keyDown"+    PointerDownAction -> String "pointerDown"+    PointerUpAction -> String "pointerUp"+    PointerMoveAction -> String "pointerMove"+    PointerCancelAction -> String "pointerCancel"++instance Arbitrary ActionType where+  arbitrary = arbitraryBoundedEnum++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-pointer-input-state>.+newtype InputSourceParameter = InputSourceParameter+  { _pointerSubtype :: Maybe PointerSubtype -- ^ @subtype@+  } deriving (Eq, Show)++instance FromJSON InputSourceParameter where+  parseJSON (Object v) = InputSourceParameter+    <$> v .:? "subtype"+  parseJSON invalid = typeMismatch "InputSourceParameter" invalid++instance ToJSON InputSourceParameter where+  toJSON InputSourceParameter{..} = object_+    [ "subtype" .=? (toJSON <$> _pointerSubtype)+    ]++instance Arbitrary InputSourceParameter where+  arbitrary = InputSourceParameter+    <$> arbitrary++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-process-an-input-source-action-sequence>.+data ActionItem = ActionItem+  { _actionType :: Maybe ActionType -- ^ @type@+  , _actionDuration :: Maybe Int -- ^ @duration@+  , _actionOrigin :: Maybe String -- ^ @origin@+  , _actionValue :: Maybe String -- ^ @value@+  , _actionButton :: Maybe Int -- ^ @button@+  , _actionX :: Maybe Int -- ^ @x@+  , _actionY :: Maybe Int -- ^ @y@+  } deriving (Eq, Show)++instance FromJSON ActionItem where+  parseJSON (Object v) = ActionItem+    <$> v .:? "type"+    <*> v .:? "duration"+    <*> v .:? "origin"+    <*> v .:? "value"+    <*> v .:? "button"+    <*> v .:? "x"+    <*> v .:? "y"+  parseJSON invalid = typeMismatch "ActionItem" invalid++instance ToJSON ActionItem where+  toJSON ActionItem{..} = object_+    [ "type" .=? (toJSON <$> _actionType)+    , "duration" .=? (toJSON <$> _actionDuration)+    , "origin" .=? (toJSON <$> _actionOrigin)+    , "value" .=? (toJSON <$> _actionValue)+    , "button" .=? (toJSON <$> _actionButton)+    , "x" .=? (toJSON <$> _actionX)+    , "y" .=? (toJSON <$> _actionY)+    ]++instance Arbitrary ActionItem where+  arbitrary = ActionItem+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++-- | All members set to `Nothing`.+emptyActionItem :: ActionItem+emptyActionItem = ActionItem+  { _actionType = Nothing+  , _actionDuration = Nothing+  , _actionOrigin = Nothing+  , _actionValue = Nothing+  , _actionButton = Nothing+  , _actionX = Nothing+  , _actionY = Nothing+  }++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-element-rect>.+data Rect = Rect+  { _rectX :: Scientific -- ^ @x@+  , _rectY :: Scientific -- ^ @y@+  , _rectWidth :: Scientific -- ^ @width@+  , _rectHeight :: Scientific -- ^ @height@+  } deriving (Eq, Show)++instance ToJSON Rect where+  toJSON Rect{..} = object+    [ "x" .= toJSON _rectX+    , "y" .= toJSON _rectY+    , "width" .= toJSON _rectWidth+    , "height" .= toJSON _rectHeight+    ]++instance FromJSON Rect where+  parseJSON (Object v) = Rect+    <$> v .: "x"+    <*> v .: "y"+    <*> v .: "width"+    <*> v .: "height"+  parseJSON invalid = typeMismatch "Rect" invalid++arbScientific :: Gen Scientific+arbScientific = scientific <$> arbitrary <*> arbitrary+  ++instance Arbitrary Rect where+  arbitrary = Rect+    <$> arbScientific+    <*> arbScientific+    <*> arbScientific+    <*> arbScientific++-- | All members set to `0`.+emptyRect :: Rect+emptyRect = Rect+  { _rectX = 0+  , _rectY = 0+  , _rectWidth = 0+  , _rectHeight = 0+  }++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-known-prompt-handling-approaches-table>.+data PromptHandler+  = DismissPrompts -- ^ @dismiss@+  | AcceptPrompts -- ^ @accept@+  | DismissPromptsAndNotify -- ^ @dismiss and notify@+  | AcceptPromptsAndNotify -- ^ @accept and notify@+  | IgnorePrompts -- ^ @ignore@+  deriving (Eq, Show, Enum, Bounded)++instance FromJSON PromptHandler where+  parseJSON (String x) = case x of+    "dismiss" -> return DismissPrompts+    "accept" -> return AcceptPrompts+    "dismiss and notify" -> return DismissPromptsAndNotify+    "accept and notify" -> return AcceptPromptsAndNotify+    "ignore" -> return IgnorePrompts+    _ -> unrecognizedValue "PromptHandler" x+  parseJSON invalid = typeMismatch "PromptHandler" invalid++instance ToJSON PromptHandler where+  toJSON x = case x of+    DismissPrompts -> String "dismiss"+    AcceptPrompts -> String "accept"+    DismissPromptsAndNotify -> String "dismiss and notify"+    AcceptPromptsAndNotify -> String "accept and notify"+    IgnorePrompts -> String "ignore"++instance Arbitrary PromptHandler where+  arbitrary = arbitraryBoundedEnum++++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-table-for-cookie-conversion>.+data Cookie = Cookie+  { _cookieName :: Maybe String -- ^ @name@+  , _cookieValue :: Maybe String -- ^ @value@+  , _cookiePath :: Maybe String -- ^ @path@+  , _cookieDomain :: Maybe String -- ^ @domain@+  , _cookieSecure :: Maybe Bool -- ^ @secure@+  , _cookieHttpOnly :: Maybe Bool -- ^ @httpOnly@+  , _cookieExpiryTime :: Maybe String -- ^ @expiryTime@+  } deriving (Eq, Show)++instance ToJSON Cookie where+  toJSON Cookie{..} = object_+    [ "name" .=? (toJSON <$> _cookieName)+    , "value" .=? (toJSON <$> _cookieValue)+    , "path" .=? (toJSON <$> _cookiePath)+    , "domain" .=? (toJSON <$> _cookieDomain)+    , "secure" .=? (toJSON <$> _cookieSecure)+    , "httpOnly" .=? (toJSON <$> _cookieHttpOnly)+    , "expiryTime" .=? (toJSON <$> _cookieExpiryTime)+    ]++instance FromJSON Cookie where+  parseJSON (Object v) = Cookie+    <$> v .:? "name"+    <*> v .:? "value"+    <*> v .:? "path"+    <*> v .:? "domain"+    <*> v .:? "secure"+    <*> v .:? "httpOnly"+    <*> v .:? "expiryTime"+  parseJSON invalid = typeMismatch "Cookie" invalid++instance Arbitrary Cookie where+  arbitrary = Cookie+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++-- | All members set to `Nothing`.+emptyCookie :: Cookie+emptyCookie = Cookie+  { _cookieName = Nothing+  , _cookieValue = Nothing+  , _cookiePath = Nothing+  , _cookieDomain = Nothing+  , _cookieSecure = Nothing+  , _cookieHttpOnly = Nothing+  , _cookieExpiryTime = Nothing+  }++-- | All members other than @name@ and @value@ set to `Nothing`.+cookie+  :: String -- ^ @name@+  -> String -- ^ @value@+  -> Cookie+cookie name value = emptyCookie+  { _cookieName = Just name+  , _cookieValue = Just value+  }
+ src/Web/Api/WebDriver/Types/Keyboard.hs view
@@ -0,0 +1,95 @@+{- |+Module      : Web.Api.WebDriver.Types.Keyboard+Description : Type representing key presses.+Copyright   : 2018, Automattic, Inc.+License     : GPL-3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX+-}++module Web.Api.WebDriver.Types.Keyboard (+    Key(..)+  , keyToChar+) where++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#keyboard-actions>.+data Key+  = UnidentifiedKey+  | CancelKey+  | HelpKey+  | BackspaceKey+  | TabKey+  | ClearKey+  | ReturnKey+  | EnterKey+  | ShiftKey+  | ControlKey+  | AltKey+  | PauseKey+  | EscapeKey+  | PageUpKey+  | PageDownKey+  | EndKey+  | HomeKey+  | ArrowLeftKey+  | ArrowUpKey+  | ArrowRightKey+  | ArrowDownKey+  | InsertKey+  | DeleteKey+  | F1Key+  | F2Key+  | F3Key+  | F4Key+  | F5Key+  | F6Key+  | F7Key+  | F8Key+  | F9Key+  | F10Key+  | F11Key+  | F12Key+  | MetaKey+  | ZenkakuHankakuKey++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#keyboard-actions>.+keyToChar :: Key -> Char+keyToChar key = case key of+  UnidentifiedKey   -> '\xe000'+  CancelKey         -> '\xe001'+  HelpKey           -> '\xe002'+  BackspaceKey      -> '\xe003'+  TabKey            -> '\xe004'+  ClearKey          -> '\xe005'+  ReturnKey         -> '\xe006'+  EnterKey          -> '\xe007'+  ShiftKey          -> '\xe008'+  ControlKey        -> '\xe009'+  AltKey            -> '\xe00a'+  PauseKey          -> '\xe00b'+  EscapeKey         -> '\xe00c'+  PageUpKey         -> '\xe00e'+  PageDownKey       -> '\xe00f'+  EndKey            -> '\xe010'+  HomeKey           -> '\xe011'+  ArrowLeftKey      -> '\xe012'+  ArrowUpKey        -> '\xe013'+  ArrowRightKey     -> '\xe014'+  ArrowDownKey      -> '\xe015'+  InsertKey         -> '\xe016'+  DeleteKey         -> '\xe017'+  F1Key             -> '\xe031'+  F2Key             -> '\xe032'+  F3Key             -> '\xe033'+  F4Key             -> '\xe034'+  F5Key             -> '\xe035'+  F6Key             -> '\xe036'+  F7Key             -> '\xe037'+  F8Key             -> '\xe038'+  F9Key             -> '\xe039'+  F10Key            -> '\xe03a'+  F11Key            -> '\xe03b'+  F12Key            -> '\xe03c'+  MetaKey           -> '\xe03d'+  ZenkakuHankakuKey -> '\xe040'
+ src/Web/Api/WebDriver/Uri.hs view
@@ -0,0 +1,71 @@+{- |+Module      : Web.Api.WebDriver.Uri+Description : Types and functions for validating parts of a URI.+Copyright   : 2018, Automattic, Inc.+License     : GPL-3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX+-}++module Web.Api.WebDriver.Uri (+    Host()+  , mkHost+  , Port()+  , mkPort+  ) where++import Test.QuickCheck+  ( Arbitrary(..), oneof, vectorOf, Positive(..) )+++-- | The host part of a URI. See <https://tools.ietf.org/html/rfc3986#page-18>.+newtype Host = Host+  { unHost :: String+  } deriving Eq++-- | Constructor for hosts that checks for invalid characters.+mkHost :: String -> Maybe Host+mkHost str =+  if all (`elem` hostAllowedChars) str+    then Just (Host str)+    else Nothing++instance Show Host where+  show = unHost++instance Arbitrary Host where+  arbitrary = do+    Positive k <- arbitrary+    str <- vectorOf k $ oneof $ map return hostAllowedChars+    case mkHost str of+      Just h -> return h+      Nothing -> error "In Arbitrary instance for Host: bad characters."++hostAllowedChars :: String+hostAllowedChars = concat+  [ ['a'..'z'], ['A'..'Z'], ['0'..'9'], ['-','_','.','~','%'] ]++++-- | The port part of a URI.+newtype Port = Port { unPort :: String }+  deriving Eq++-- | Constructor for ports.+mkPort :: String -> Maybe Port+mkPort str =+  if all (`elem` ['0'..'9']) str+    then Just (Port str)+    else Nothing++instance Show Port where+  show = unPort++instance Arbitrary Port where+  arbitrary = do+    Positive k <- arbitrary+    str <- vectorOf k $ oneof $ map return ['0'..'9']+    case mkPort str of+      Just p -> return p+      Nothing -> error "In Arbitrary instance for Port: bad characters."
+ test/Main.hs view
@@ -0,0 +1,40 @@+module Main where++import System.Environment (setEnv, getArgs, withArgs)+import System.Exit (exitFailure)+import System.Directory (getCurrentDirectory)+import Control.Concurrent.MVar (newMVar)+import Data.IORef++import Test.Tasty+import Test.Tasty.WebDriver++import Test.Tasty.WebDriver.Config.Test+import Web.Api.WebDriver.Assert.Test+import Web.Api.WebDriver.Monad.Test+import Web.Api.WebDriver.Types.Test+++main :: IO ()+main = do++  putStrLn ""+  putStrLn "\x1b[1;34m      ___  __   __   __          ___  __           __   __     ___  ___  __  ___ \x1b[0;39;49m"+  putStrLn "\x1b[1;34m|  | |__  |__) |  \\ |__) | \\  / |__  |__) __ |  | '__\\ /  ` __  |  |__  /__`  |  \x1b[0;39;49m"+  putStrLn "\x1b[1;34m|/\\| |___ |__) |__/ |  \\ |  \\/  |___ |  \\    |/\\| .__/ \\__,     |  |___ .__/  |  \x1b[0;39;49m"+  putStrLn "\x1b[1;34m                                                                                 \x1b[0;39;49m"++  setEnv "TASTY_NUM_THREADS" "2" -- needed for live tests+  testPagePath <- fmap (\path -> path ++ "/test/page") getCurrentDirectory+  lock <- newMVar ()++  args <- getArgs+  withArgs (["--wd-remote-ends","geckodriver https://localhost:4444 https://localhost:4445 chromedriver https://localhost:9515 https://localhost:9516"] ++ args) $+    defaultWebDriverMain $+      (localOption $ NumRetries 3) $+        testGroup "All Tests"+          [ Test.Tasty.WebDriver.Config.Test.tests+          , Web.Api.WebDriver.Assert.Test.tests lock+          , Web.Api.WebDriver.Types.Test.tests+          , Web.Api.WebDriver.Monad.Test.tests ("file://" ++ testPagePath)+          ]
+ test/Test/Tasty/WebDriver/Config/Test.hs view
@@ -0,0 +1,167 @@+module Test.Tasty.WebDriver.Config.Test (+    tests+  ) where++import qualified Test.Tasty as TT+import qualified Test.Tasty.HUnit as HU+import qualified Data.Map.Strict as MS++import Test.Tasty.WebDriver.Config++tests :: TT.TestTree+tests = TT.testGroup "Test.Tasty.WebDriver.Config"+  [ check_parseRemoteEnd+  , check_parseRemoteEndOption+  , check_parseRemoteEndConfig+  ]++checkParser :: (Eq a, Show a) => (String -> a) -> (String, String, a) -> TT.TestTree+checkParser f (title, str, x) =+  let y = f str in+  HU.testCase title $+    if y == x+      then return ()+      else do+        HU.assertFailure $ "Error parsing '" ++ str ++ "': expected "+          ++ show x ++ " but got " ++ show y++check_parseRemoteEnd :: TT.TestTree+check_parseRemoteEnd = TT.testGroup "parseRemoteEnd" $+  map (checkParser parseRemoteEnd) _parseRemoteEnd_cases++_parseRemoteEnd_cases :: [(String, String, Either String RemoteEnd)]+_parseRemoteEnd_cases =+  [ ( "'localhost'"+    , "localhost"+    , Left "Could not parse remote end URI 'localhost'."+    )++  , ( "'localhost:4444'"+    , "localhost:4444"+    , Left "Error parsing authority for URI 'localhost:4444'."+    )++  , ( "'http://localhost:4444'"+    , "http://localhost:4444"+    , Right $ RemoteEnd "localhost" 4444 ""+    )++  , ( "'https://localhost:4444'"+    , "https://localhost:4444"+    , Right $ RemoteEnd "localhost" 4444 ""+    )++  , ( "'http://localhost'"+    , "http://localhost"+    , Right $ RemoteEnd "localhost" 4444 ""+    )++  , ( "'https://localhost'"+    , "https://localhost"+    , Right $ RemoteEnd "localhost" 4444 ""+    )+  ]++check_parseRemoteEndOption :: TT.TestTree+check_parseRemoteEndOption = TT.testGroup "parseRemoteEndOption" $+  map (checkParser parseRemoteEndOption) _parseRemoteEndOption_cases++_parseRemoteEndOption_cases :: [(String, String, Either String RemoteEndPool)]+_parseRemoteEndOption_cases =+  [ ( "geckodriver+1"+    , "geckodriver https://localhost:4444"+    , Right $ RemoteEndPool $+        MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 ""])]+    )++  , ( "geckodriver+1 (repeated)"+    , "geckodriver https://localhost:4444 https://localhost:4444"+    , Right $ RemoteEndPool $+        MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 ""])]+    )++  , ( "geckodriver+2"+    , "geckodriver https://localhost:4444 https://localhost:4445"+    , Right $ RemoteEndPool $+        MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 "", RemoteEnd "localhost" 4445 ""])]+    )++  , ( "chromedriver+1"+    , "chromedriver https://localhost:4444"+    , Right $ RemoteEndPool $+        MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 ""])]+    )++  , ( "chromedriver+1 (repeated)"+    , "chromedriver https://localhost:4444 https://localhost:4444"+    , Right $ RemoteEndPool $+        MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 ""])]+    )++  , ( "chromedriver+2"+    , "chromedriver https://localhost:4444 https://localhost:4445"+    , Right $ RemoteEndPool $+        MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 "", RemoteEnd "localhost" 4445 ""])]+    )++  , ( "geckodriver+1, chromedriver+1"+    , "geckodriver https://localhost:4444 chromedriver https://localhost:9515"+    , Right $ RemoteEndPool $+        MS.fromList+          [ (Geckodriver, [RemoteEnd "localhost" 4444 ""])+          , (Chromedriver, [RemoteEnd "localhost" 9515 ""])+          ]+    )+  ]++check_parseRemoteEndConfig :: TT.TestTree+check_parseRemoteEndConfig = TT.testGroup "parseRemoteEndConfig" $+  map (checkParser parseRemoteEndConfig) _parseRemoteEndConfig_cases++_parseRemoteEndConfig_cases :: [(String, String, Either String RemoteEndPool)]+_parseRemoteEndConfig_cases =+  [ ( "geckodriver+1"+    , "geckodriver\n- https://localhost:4444\n"+    , Right $ RemoteEndPool $+        MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 ""])]+    )++  , ( "geckodriver+1 (repeated)"+    , "geckodriver\n- https://localhost:4444\n- https://localhost:4444\n"+    , Right $ RemoteEndPool $+        MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 ""])]+    )++  , ( "geckodriver+2"+    , "geckodriver\n- https://localhost:4444\n- https://localhost:4445\n"+    , Right $ RemoteEndPool $+        MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 "", RemoteEnd "localhost" 4445 ""])]+    )++  , ( "chromedriver+1"+    , "chromedriver\n- https://localhost:4444\n"+    , Right $ RemoteEndPool $+        MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 ""])]+    )++  , ( "chromedriver+1 (repeated)"+    , "chromedriver\n- https://localhost:4444\n- https://localhost:4444\n"+    , Right $ RemoteEndPool $+        MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 ""])]+    )++  , ( "chromedriver+2"+    , "chromedriver\n- https://localhost:4444\n- https://localhost:4445\n"+    , Right $ RemoteEndPool $+        MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 "", RemoteEnd "localhost" 4445 ""])]+    )++  , ( "geckodriver+1, chromedriver+1"+    , "geckodriver\n- https://localhost:4444\nchromedriver\n- https://localhost:9515\n"+    , Right $ RemoteEndPool $+        MS.fromList+          [ (Geckodriver, [RemoteEnd "localhost" 4444 ""])+          , (Chromedriver, [RemoteEnd "localhost" 9515 ""])+          ]+    )+  ]
+ test/Web/Api/WebDriver/Assert/Test.hs view
@@ -0,0 +1,303 @@+{-# LANGUAGE Rank2Types, OverloadedStrings #-}+module Web.Api.WebDriver.Assert.Test (+    tests+) where++import System.IO+import Data.String++import qualified Test.Tasty as TT (TestTree(), testGroup)+import qualified Test.Tasty.QuickCheck as QC (testProperty)+import qualified Test.Tasty.HUnit as HU++import Control.Concurrent (MVar)+import qualified Network.Wreq as Wreq+import qualified Data.Map as MS++import Data.MockIO+import Control.Monad.Script.Http+import Web.Api.WebDriver.Monad.Test.Server++import Web.Api.WebDriver+import Web.Api.WebDriver.Monad.Test.Server++++tests :: MVar () -> TT.TestTree+tests lock = TT.testGroup "Web.Api.WebDriver.Assert"+  [ TT.testGroup "Mock"+    [ assertionTestCases (mockConfig lock) condMockIO+    ]+  , TT.testGroup "Real"+    [ assertionTestCases (realConfig lock) condIO+    ]+  ]++++condIO+  :: IO (Either (E WDError) t, S WDState, W WDError WDLog)+  -> IO AssertionSummary+condIO x = do+  (_,_,w) <- x+  return $ summarize $ getAssertions $ logEntries w++realConfig :: MVar () -> WebDriverConfig IO+realConfig lock = WDConfig+  { _initialState = defaultWebDriverState+  , _environment = defaultWebDriverEnvironment+    { _logLock = Just lock+    , _logOptions = defaultWebDriverLogOptions+      { _logSilent = True+      }+    }+  , _evaluator = evalIO evalWDAct+  }++++condMockIO+  :: MockIO WebDriverServerState (Either (E WDError) t, S WDState, W WDError WDLog)+  -> IO AssertionSummary+condMockIO x = do+  let ((_,_,w),_) = runMockIO x defaultWebDriverServer+  return $ summarize $ getAssertions $ logEntries w++mockConfig :: MVar () -> WebDriverConfig (MockIO WebDriverServerState)+mockConfig lock = WDConfig+  { _evaluator = evalMockIO evalWDActMockIO+  , _initialState = defaultWebDriverState+  , _environment = defaultWebDriverEnvironment+    { _logLock = Just lock+    , _logOptions = defaultWebDriverLogOptions+      { _logSilent = True+      }+    }+  }++++++assertionTestCases+  :: (Monad eff)+  => WebDriverConfig eff+  -> (eff (Either (E WDError) (), S WDState, W WDError WDLog) -> IO AssertionSummary)+  -> TT.TestTree+assertionTestCases config cond = TT.testGroup "Assertions"+  [ QC.testProperty "assertSuccess" $+    checkWebDriver config cond+      (== summarize [success "Success!" "yay!"]) $+      do+        assertSuccess "yay!"++  , QC.testProperty "assertFailure" $+    checkWebDriver config cond+      (== summarize [failure "Failure :(" "oh no"]) $+      do+        assertFailure "oh no"++  , QC.testProperty "assertTrue (success)" $ \msg ->+    checkWebDriver config cond+      (== summarize [success "True is True" msg]) $+      do+        assertTrue True msg++  , QC.testProperty "assertTrue (failure)" $ \msg ->+    checkWebDriver config cond+      (== summarize [failure "False is True" msg]) $+      do+        assertTrue False msg++  , QC.testProperty "assertFalse (success)" $ \msg ->+    checkWebDriver config cond+      (== summarize [success "False is False" msg]) $+      do+        assertFalse False msg++  , QC.testProperty "assertFalse (failure)" $ \msg ->+    checkWebDriver config cond+      (== summarize [failure "True is False" msg]) $+      do+        assertFalse True msg++  , QC.testProperty "assertEqual (Int, success)" $ \k ->+    checkWebDriver config cond+      (== summarize+        [success+          (fromString $ show k ++ " is equal to " ++ show k)+          (fromString $ show k)+        ]+      ) $+      do+        assertEqual (k :: Int) k (fromString $ show k)++  , QC.testProperty "assertEqual (Int, failure)" $ \k ->+    checkWebDriver config cond+      (== summarize+        [failure+          (fromString $ show (k+1) ++ " is equal to " ++ show k)+          (fromString $ show k)+        ]+      ) $+      do+        assertEqual (k+1 :: Int) k (fromString $ show k)++  , QC.testProperty "assertEqual (String, success)" $ \str ->+    checkWebDriver config cond+      (== summarize+        [success+          (fromString $ show str ++ " is equal to " ++ show str)+          (fromString str)+        ]+      ) $+      do+        assertEqual (str :: String) str (fromString str)++  , QC.testProperty "assertEqual (String, failure)" $ \str ->+    checkWebDriver config cond+      (== summarize+        [failure+          (fromString $ show (str++"?") ++ " is equal to " ++ show str)+          (fromString str)+        ]+      ) $+      do+        assertEqual (str++"?" :: String) str (fromString str)++  , QC.testProperty "assertNotEqual (Int, success)" $ \k ->+    checkWebDriver config cond+      (== summarize+        [success+          (fromString $ show (k+1) ++ " is not equal to " ++ show k)+          (fromString $ show k)+        ]+      ) $+      do+        assertNotEqual (k+1 :: Int) k (fromString $ show k)++  , QC.testProperty "assertNotEqual (Int, failure)" $ \k ->+    checkWebDriver config cond+      (== summarize+        [failure+          (fromString $ show k ++ " is not equal to " ++ show k)+          (fromString $ show k)+        ]+      ) $+      do+        assertNotEqual (k :: Int) k (fromString $ show k)++  , QC.testProperty "assertNotEqual (String, success)" $ \str ->+    checkWebDriver config cond+      (== summarize+        [success+          (fromString $ show (str++"?") ++ " is not equal to " ++ show str)+          (fromString str)+        ]+      ) $+      do+        assertNotEqual (str++"?" :: String) str (fromString str)++  , QC.testProperty "assertNotEqual (String, failure)" $ \str ->+    checkWebDriver config cond+      (== summarize+        [failure+          (fromString $ show str ++ " is not equal to " ++ show str)+          (fromString str)+        ]+      ) $+      do+        assertNotEqual (str :: String) str (fromString str)++    , QC.testProperty "assertIsSubstring (success)" $ \str1 str2 ->+    checkWebDriver config cond+      (== summarize+        [success+          (fromString $ show str1 ++ " is a substring of " ++ show (str2++str1++str2))+          (fromString str1)+        ]+      ) $+      do+        assertIsSubstring (str1 :: String) (str2++str1++str2) (fromString str1)++    , QC.testProperty "assertIsSubstring (failure)" $ \c str1 str2 ->+    let str3 = filter (/= c) str2 in+    checkWebDriver config cond+      (== summarize+        [failure+          (fromString $ show (c:str1) ++ " is a substring of " ++ show str3)+          (fromString str1)+        ]+      ) $+      do+        assertIsSubstring (c:str1 :: String) (str3) (fromString str1)++    , QC.testProperty "assertIsNotSubstring (success)" $ \c str1 str2 ->+    let str3 = filter (/= c) str2 in+    checkWebDriver config cond+      (== summarize+        [success+          (fromString $ show (c:str1) ++ " is not a substring of " ++ show str3)+          (fromString str1)+        ]+      ) $+      do+        assertIsNotSubstring (c:str1 :: String) (str3) (fromString str1)++    , QC.testProperty "assertIsNotSubstring (failure)" $ \str1 str2 ->+    checkWebDriver config cond+      (== summarize+        [failure+          (fromString $ show str1 ++ " is not a substring of " ++ show (str2++str1++str2))+          (fromString str1)+        ]+      ) $+      do+        assertIsNotSubstring (str1 :: String) (str2++str1++str2) (fromString str1)++    , QC.testProperty "assertIsNamedSubstring (success)" $ \name str1 str2 ->+    checkWebDriver config cond+      (== summarize+        [success+          (fromString $ show str1 ++ " is a substring of " ++ name)+          (fromString str1)+        ]+      ) $+      do+        assertIsNamedSubstring (str1 :: String) (str2++str1++str2, name) (fromString str1)++    , QC.testProperty "assertIsNamedSubstring (failure)" $ \name c str1 str2 ->+    let str3 = filter (/= c) str2 in+    checkWebDriver config cond+      (== summarize+        [failure+          (fromString $ show (c:str1) ++ " is a substring of " ++ name)+          (fromString str1)+        ]+      ) $+      do+        assertIsNamedSubstring (c:str1 :: String) (str3,name) (fromString str1)++    , QC.testProperty "assertIsNotNamedSubstring (success)" $ \name c str1 str2 ->+    let str3 = filter (/= c) str2 in+    checkWebDriver config cond+      (== summarize+        [success+          (fromString $ show (c:str1) ++ " is not a substring of " ++ name)+          (fromString str1)+        ]+      ) $+      do+        assertIsNotNamedSubstring (c:str1 :: String) (str3,name) (fromString str1)++    , QC.testProperty "assertIsNotNamedSubstring (failure)" $ \name str1 str2 ->+    checkWebDriver config cond+      (== summarize+        [failure+          (fromString $ show str1 ++ " is not a substring of " ++ name)+          (fromString str1)+        ]+      ) $+      do+        assertIsNotNamedSubstring (str1 :: String) (str2++str1++str2, name) (fromString str1)+  ]
+ test/Web/Api/WebDriver/Monad/Test.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE BangPatterns, GADTs #-}+module Web.Api.WebDriver.Monad.Test (+    tests+) where++import Data.Typeable+  ( Typeable )+import System.IO++import Test.Tasty (TestTree(), testGroup, localOption, Timeout(NoTimeout))++import Data.MockIO++import Web.Api.WebDriver+import Test.Tasty.WebDriver++import Web.Api.WebDriver.Monad.Test.Server+import Web.Api.WebDriver.Monad.Test.Session.Success+import Web.Api.WebDriver.Monad.Test.Session.UnknownError+import Web.Api.WebDriver.Monad.Test.Session.InvalidElementState+++tests :: FilePath -> TestTree+tests path = testGroup "Web.Api.WebDriver.Monad"+  [   localOption (ApiResponseFormat SpecFormat)+    $ localOption (SilentLog)+    $ testGroup "Mock Driver" $ endpointTests testCaseMockIO path++  ,   localOption (Driver Geckodriver)+    $ localOption (ApiResponseFormat SpecFormat)+    $ localOption (Headless True)+    $ localOption (SilentLog)+    $ testGroup "Geckodriver" $ endpointTests testCase path++  ,   localOption (Driver Chromedriver)+    $ localOption (ApiResponseFormat ChromeFormat)+    $ localOption (Headless True)+    $ ifTierIs TEST (localOption (BrowserPath $ Just "/usr/bin/google-chrome"))+    $ localOption (SilentLog)+    $ testGroup "Chromedriver" $ endpointTests testCase path+  ]++++testCaseMockIO :: String -> WebDriver (MockIO WebDriverServerState) () -> TestTree+testCaseMockIO name = testCaseM name+  (evalMockIO evalWDActMockIO)+  (\x -> return $ fst $ runMockIO x defaultWebDriverServer)++endpointTests+  :: (Monad eff)+  => (String -> WebDriver eff () -> TestTree)+  -> FilePath+  -> [TestTree]+endpointTests buildTestCase path =+  [ successfulExit buildTestCase path+  , invalidElementStateExit buildTestCase path+  , unknownErrorExit buildTestCase path+  ]
+ test/Web/Api/WebDriver/Monad/Test/Server.hs view
@@ -0,0 +1,1029 @@+{-# LANGUAGE OverloadedStrings, BangPatterns, FlexibleInstances, RecordWildCards #-}+module Web.Api.WebDriver.Monad.Test.Server (+    WebDriverServerState(..)+  , defaultWebDriverServerState+  , defaultWebDriverServer+  ) where++import Data.List+import Data.Text (Text, pack, unpack)+import Data.Text.Encoding (decodeUtf8)+import qualified Data.HashMap.Strict as HMS+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString as SB+import qualified Data.ByteString.Base64 as B64+import qualified Data.Vector as V+import Data.Aeson+import Data.Aeson.Lens+import Control.Lens+import Data.HashMap.Strict+import Network.HTTP.Client (HttpException)+import Network.HTTP.Client.Internal+import Network.HTTP.Types+import qualified Network.Wreq.Session as WreqS+import Codec.Picture+import Codec.Picture.Saving++import Data.MockIO+import Data.MockIO.FileSystem++import Web.Api.WebDriver+import Web.Api.WebDriver.Monad.Test.Server.State+import Web.Api.WebDriver.Monad.Test.Server.Page++++defaultWebDriverServer :: MockWorld WebDriverServerState+defaultWebDriverServer = MockWorld+  { _files = emptyFileSystem+  , _time = epoch+  , _serverState = MockServer defaultWebDriverServerState+  , _httpGet = \url -> case splitUrl $ stripScheme url of+      {- Status -}+      [_,"status"] ->+        get_session_id_status++      {- Get Timeouts -}+      [_,"session",session_id,"timeouts"] ->+        get_session_id_timeouts session_id++      {- Get Current Url -}+      [_,"session",session_id,"url"] ->+        get_session_id_url session_id++      {- Get Title -}+      [_,"session",session_id,"title"] ->+        get_session_id_title session_id++      {- Get Window Handle -}+      [_,"session",session_id,"window"] ->+        get_session_id_window session_id++      {- Get Window Handles -}+      [_,"session",session_id,"window","handles"] ->+        get_session_id_window_handles session_id++      {- Get Window Rect -}+      [_,"session",session_id,"window","rect"] ->+        get_session_id_window_rect session_id++      {- Get Active Element -}+      [_,"session",session_id,"element","active"] ->+        get_session_id_element_active session_id++      {- Is Element Selected -}+      [_,"session",session_id,"element",element_id,"selected"] ->+        get_session_id_element_id_selected session_id element_id++      {- Get Element Attribute -}+      [_,"session",session_id,"element",element_id,"attribute",name] ->+        get_session_id_element_id_attribute_name session_id element_id name++      {- Get Element Property -}+      [_,"session",session_id,"element",element_id,"property",name] ->+        undefined++      {- Get Element CSS Value -}+      [_,"session",session_id,"element",element_id,"css",name] ->+        get_session_id_element_id_css_name session_id element_id name++      {- Get Element Text -}+      [_,"session",session_id,"element",element_id,"text"] ->+        get_session_id_element_id_text session_id element_id++      {- Get Element Tag Name -}+      [_,"session",session_id,"element",element_id,"name"] ->+        get_session_id_element_id_name session_id element_id++      {- Get Element Rect -}+      [_,"session",session_id,"element",element_id,"rect"] ->+        get_session_id_element_id_rect session_id element_id++      {- Is Element Enabled -}+      [_,"session",session_id,"element",element_id,"enabled"] ->+        get_session_id_element_id_enabled session_id element_id++      {- Get Page Source -}+      [_,"session",session_id,"source"] ->+        get_session_id_source session_id++      {- Get All Cookies -}+      [_,"session",session_id,"cookie"] ->+        get_session_id_cookie session_id++      {- Get Named Cookie -}+      [_,"session",session_id,"cookie",name] ->+        get_session_id_cookie_name session_id++      {- Get Alert Text -}+      [_,"session",session_id,"alert","text"] ->+        get_session_id_alert_text session_id++      {- Take Screenshot -}+      [_,"session",session_id,"screenshot"] ->+        get_session_id_screenshot session_id++      {- Take Element Screenshot -}+      [_,"session",session_id,"element",element_id,"screenshot"] ->+        get_session_id_element_id_screenshot session_id element_id++      _ -> error $ "defaultWebDriverServer: get url: " ++ url +++        "' parsed as " ++ (show $ splitUrl $ stripScheme url)++  , _httpPost = \url payload -> case splitUrl $ stripScheme url of+      {- New Session -}+      [_,"session"] ->+        post_session++      {- Set Timeouts -}+      [_,"session",session_id,"timeouts"] ->+        post_session_id_timeouts session_id payload++      {- Navigate To -}+      [_,"session",session_id,"url"] ->+        post_session_id_url session_id payload++      {- Back -}+      [_,"session",session_id,"back"] ->+        post_session_id_back session_id++      {- Forward -}+      [_,"session",session_id,"forward"] ->+        post_session_id_forward session_id++      {- Refresh -}+      [_,"session",session_id,"refresh"] ->+        post_session_id_refresh session_id++      {- Switch To Window -}+      [_,"session",session_id,"window"] ->+        post_session_id_window session_id payload++      {- Switch To Frame -}+      [_,"session",session_id,"frame"] ->+        post_session_id_frame session_id payload++      {- Switch To Parent Frame -}+      [_,"session",session_id,"frame","parent"] ->+        post_session_id_frame_parent session_id++      {- Set Window Rect -}+      [_,"session",session_id,"window","rect"] ->+        post_session_id_window_rect session_id payload++      {- Maximize Window -}+      [_,"session",session_id,"window","maximize"] ->+        post_session_id_window_maximize session_id++      {- Minimize Window -}+      [_,"session",session_id,"window","minimize"] ->+        post_session_id_window_minimize session_id++      {- Fullscreen Window -}+      [_,"session",session_id,"window","fullscreen"] ->+        post_session_id_window_fullscreen session_id++      {- Find Element -}+      [_,"session",session_id,"element"] ->+        post_session_id_element session_id payload++      {- Find Elements -}+      [_,"session",session_id,"elements"] ->+        post_session_id_elements session_id payload++      {- Find Element From Element -}+      [_,"session",session_id,"element",element_id,"element"] ->+        post_session_id_element_id_element session_id element_id payload++      {- Find Elements From Element -}+      [_,"session",session_id,"element",element_id,"elements"] ->+        post_session_id_element_id_elements session_id element_id payload++      {- Element Click -}+      [_,"session",session_id,"element",element_id,"click"] ->+        post_session_id_element_id_click session_id element_id++      {- Element Clear -}+      [_,"session",session_id,"element",element_id,"clear"] ->+        post_session_id_element_id_clear session_id element_id++      {- Element Send Keys -}+      [_,"session",session_id,"element",element_id,"value"] ->+        post_session_id_element_id_value session_id element_id payload+ +      {- Execute Script -}+      [_,"session",session_id,"execute","sync"] ->+        undefined++      {- Execute Async Script -}+      [_,"session",session_id,"execute","async"] ->+        undefined++      {- Add Cookie -}+      [_,"session",session_id,"cookie"] ->+        post_session_id_cookie session_id payload++      {- Perform Actions -}+      [_,"session",session_id,"actions"] ->+        post_session_id_actions session_id payload++      {- Dismiss Alert -}+      [_,"session",session_id,"alert","dismiss"] ->+        post_session_id_alert_dismiss session_id++      {- Accept Alert -}+      [_,"session",session_id,"alert","accept"] ->+        post_session_id_alert_accept session_id++      {- Send Alert Text -}+      [_,"session",session_id,"alert","text"] ->+        post_session_id_alert_text session_id++      _ -> error $ "defaultWebDriverServer: post url: '" ++ url +++        "' parsed as " ++ (show $ splitUrl $ stripScheme url)++  , _httpDelete = \url -> case splitUrl $ stripScheme url of+      {- Delete Session -}+      [_,"session",session_id] ->+        delete_session_id session_id++      {- Close Window -}+      [_,"session",session_id,"window"] ->+        delete_session_id_window session_id++      {- Delete Cookie -}+      [_,"session",session_id,"cookie",name] ->+        delete_session_id_cookie_name session_id name++      {- Delete All Cookies -}+      [_,"session",session_id,"cookie"] ->+        delete_session_id_cookie session_id++      {- Release Actions -}+      [_,"session",session_id,"actions"] ->+        delete_session_id_actions session_id++      _ -> error $ "defaultWebDriverServer: delete url: " ++ url +++        "' parsed as " ++ (show $ splitUrl $ stripScheme url)+  }++stripScheme :: String -> String+stripScheme str = case dropWhile (== ' ') str of+  ('h':'t':'t':'p':':':'/':'/':rest) -> rest+  ('h':'t':'t':'p':'s':':':'/':'/':rest) -> rest+  _ -> str++splitUrl :: String -> [String]+splitUrl = unfoldr foo+  where+    foo [] = Nothing+    foo xs = case span (/= '/') xs of+      (as,[]) -> Just (as,[])+      (as,b:bs) -> Just (as,bs)++++{--------------------}+{- Request Handlers -}+{--------------------}++{- New Session -}++post_session+  :: MockNetwork WebDriverServerState HttpResponse+post_session = do+  st <- getMockServer+  case _create_session st of+    Nothing -> errorMockNetwork _err_session_not_created+    Just (_id, _st) -> do+      modifyMockServer (const _st)+      return $ _success_with_value $ object+        [ ("sessionId", String $ pack _id)+        ]+++{- Delete Session -}++delete_session_id+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+delete_session_id session_id = do+  verifyIsActiveSession session_id+  closeTheSession session_id+  return _success_with_empty_object+++{- Status -}++get_session_id_status+  :: MockNetwork WebDriverServerState HttpResponse+get_session_id_status = do+  return $ _success_with_value $ object+    [ ("ready", Bool True)+    , ("message", String "ready")+    ]+++{- Get Timeouts -}++get_session_id_timeouts+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_timeouts session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ object+    [ ("script", Number 0)+    , ("pageLoad", Number 0)+    , ("implicit", Number 0)+    ]+++{- Set Timeouts -}++post_session_id_timeouts+  :: String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_timeouts session_id !payload = do+  verifyIsActiveSession session_id+  case decode payload of+    Nothing -> errorMockNetwork (_err_invalid_argument "Timeouts did not parse")+    Just (Object m) -> return _success_with_empty_object+    Just _ -> errorMockNetwork (_err_invalid_argument "Timeouts must be an object")+++{- Navigate To -}++post_session_id_url+  :: String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_url !session_id !payload = do+  verifyIsActiveSession session_id+  url <- getAProperty "url" payload+  st <- getMockServer+  case _load_page url st of+    Nothing -> errorMockNetwork _err_unknown_error+    Just _st -> do+      modifyMockServer (const _st)+      return _success_with_empty_object+++{- Get Current Url -}++get_session_id_url+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_url session_id = do+  verifyIsActiveSession session_id+  url <- fmap _get_current_url $ getMockServer+  return $ _success_with_value $ String $ pack url+++{- Back -}++post_session_id_back+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_back !session_id = do+  verifyIsActiveSession session_id+  modifyMockServer _go_back+  return _success_with_empty_object+++{- Forward -}++post_session_id_forward+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_forward !session_id = do+  verifyIsActiveSession session_id+  modifyMockServer _go_forward+  return _success_with_empty_object+++{- Refresh -}++post_session_id_refresh+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_refresh !session_id = do+  verifyIsActiveSession session_id+  return _success_with_empty_object+++{- Get Title -}++get_session_id_title+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_title session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ String $ pack "fake title"+++{- Get Window Handle -}++get_session_id_window+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_window session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ String "window-1"+++{- Close Window -}++delete_session_id_window+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+delete_session_id_window session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ toJSONList [String "window-1"]+++{- Switch To Window -}++post_session_id_window+  :: String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_window session_id payload = do+  verifyIsActiveSession session_id+  return _success_with_empty_object+++{- Get Window Handles -}++get_session_id_window_handles+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_window_handles session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ toJSONList [ String "handle-id" ]+++{- Switch To Frame -}++post_session_id_frame+  :: String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_frame session_id !payload = do+  verifyIsActiveSession session_id+  return _success_with_empty_object+++{- Switch To Parent Frame -}++post_session_id_frame_parent+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_frame_parent session_id = do+  verifyIsActiveSession session_id+  return _success_with_empty_object+++{- Get Window Rect -}++get_session_id_window_rect+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_window_rect session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ object+    [ ("x", Number 0)+    , ("y", Number 0)+    , ("height", Number 480)+    , ("width", Number 640)+    ]+++{- Set Window Rect -}++post_session_id_window_rect+  :: String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_window_rect session_id payload = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ object+    [ ("x", Number 0)+    , ("y", Number 0)+    , ("height", Number 480)+    , ("width", Number 640)+    ]+++{- Maximize Window -}++post_session_id_window_maximize+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_window_maximize !session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ object+    [ ("x", Number 0)+    , ("y", Number 0)+    , ("height", Number 480)+    , ("width", Number 640)+    ]+++{- Minimize Window -}++post_session_id_window_minimize+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_window_minimize !session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ object+    [ ("x", Number 0)+    , ("y", Number 0)+    , ("height", Number 0)+    , ("width", Number 0)+    ]+++{- Fullscreen Window -}++post_session_id_window_fullscreen+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_window_fullscreen !session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ object+    [ ("x", Number 0)+    , ("y", Number 0)+    , ("height", Number 480)+    , ("width", Number 640)+    ]+++{- Find Element -}++post_session_id_element+  :: String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_element session_id payload = do+  verifyIsActiveSession session_id+  strategy <- getAProperty "using" payload+  case strategy of+    "css selector" -> do+      val <- getAProperty "value" payload+      sel <- parseCssSelector val+      doc <- fmap (contents . _current_page) getMockServer+      case cssMatchDocument sel doc of+        [] -> errorMockNetwork _err_no_such_element+        (d:_) -> do+          return $ _success_with_value $ object+            [ ("element-6066-11e4-a52e-4f735466cecf", String (pack $ elementId d))+            ]+    _ -> do+      return $ _success_with_value $ object+        [ ("element-6066-11e4-a52e-4f735466cecf", String "element-id")+        ]+++{- Find Elements -}++post_session_id_elements+  :: String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_elements session_id payload = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ toJSONList [object+    [ ("element-6066-11e4-a52e-4f735466cecf", String "element-id")+    ]]+++{- Find Element From Element -}++post_session_id_element_id_element+  :: String+  -> String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_element_id_element session_id element_id payload = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ object+      [ ("element-6066-11e4-a52e-4f735466cecf", String "element-id")+      ]+++{- Find Elements From Element -}++post_session_id_element_id_elements+  :: String+  -> String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_element_id_elements session_id element_id payload = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ toJSONList [object+    [ ("element-6066-11e4-a52e-4f735466cecf", String "element-id")+    ]]+++{- Get Active Element -}++get_session_id_element_active+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_element_active session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ object+    [ ("element-6066-11e4-a52e-4f735466cecf", String "element-id")+    ]+++{- Is Element Selected -}++get_session_id_element_id_selected+  :: String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_element_id_selected session_id element_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ Bool True+++{- Get Element Attribute -}++get_session_id_element_id_attribute_name+  :: String+  -> String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_element_id_attribute_name session_id element_id name = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ String "foo"++{- TODO: get_session_id_element_id_property_name -}++get_session_id_element_id_css_name+  :: String+  -> String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_element_id_css_name session_id element_id name = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ String "none"+++{- Get Element Text -}++get_session_id_element_id_text+  :: String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_element_id_text session_id element_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ String "foo"+++{- Get Element Tag Name -}++get_session_id_element_id_name+  :: String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_element_id_name session_id element_id = do+  verifyIsActiveSession session_id+  doc <- getElementFromId element_id+  return $ _success_with_value $ String (pack $ show $ tag doc)+++{- Get Element Rect -}++get_session_id_element_id_rect+  :: String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_element_id_rect !session_id !element_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ object+    [ ("x", Number 0)+    , ("y", Number 0)+    , ("height", Number 48)+    , ("width", Number 64)+    ]++get_session_id_element_id_enabled+  :: String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_element_id_enabled session_id element_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ Bool True++post_session_id_element_id_click+  :: String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_element_id_click session_id element_id = do+  verifyIsActiveSession session_id+  return _success_with_empty_object+++{- Element Clear -}++post_session_id_element_id_clear+  :: String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_element_id_clear session_id element_id = do+  verifyIsActiveSession session_id+  doc <- getElementFromId element_id+  case doc of+    Text _ -> errorMockNetwork _err_invalid_element_state+    d -> if tagIsClearable (tag d)+      then return _success_with_empty_object+      else errorMockNetwork _err_invalid_element_state+++{- Element Send Keys -}++post_session_id_element_id_value+  :: String+  -> String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_element_id_value session_id element_id payload = do+  verifyIsActiveSession session_id+  return _success_with_empty_object+++{- Get Page Source -}++get_session_id_source+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_source session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ String "the source"++{- TODO: post_session_id_execute_sync -}++{- TODO: post_session_id_execute_async -}+++{- Get All Cookies -}++get_session_id_cookie+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_cookie session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ Array $ V.fromList []+++{- Get Named Cookie -}++get_session_id_cookie_name+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_cookie_name session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ toJSON $ emptyCookie+      { _cookieName = Just "fakeCookie"+      , _cookieValue = Just "fakeValue"+      }++post_session_id_cookie+  :: String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_cookie session_id payload = do+  verifyIsActiveSession session_id+  return _success_with_empty_object++delete_session_id_cookie_name+  :: String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+delete_session_id_cookie_name session_id name = do+  verifyIsActiveSession session_id+  return _success_with_empty_object++delete_session_id_cookie+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+delete_session_id_cookie session_id = do+  verifyIsActiveSession session_id+  return _success_with_empty_object+++{- Perform Actions -}++post_session_id_actions+  :: String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_actions !session_id payload = do+  verifyIsActiveSession session_id+  return _success_with_empty_object++delete_session_id_actions+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+delete_session_id_actions !session_id = do+  verifyIsActiveSession session_id+  return _success_with_empty_object+++{- Dismiss Alert -}++post_session_id_alert_dismiss+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_alert_dismiss session_id = do+  verifyIsActiveSession session_id+  return _success_with_empty_object+++{- Accept Alert -}++post_session_id_alert_accept+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_alert_accept session_id = do+  verifyIsActiveSession session_id+  return _success_with_empty_object+++{- Get Alert Text -}++get_session_id_alert_text+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_alert_text session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ String "WOO!!"+++{- Send Alert Text -}++post_session_id_alert_text+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_alert_text session_id = do+  verifyIsActiveSession session_id+  return _success_with_empty_object+++{- Take Screenshot -}++get_session_id_screenshot+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_screenshot !session_id = do+  let+    black :: Int -> Int -> PixelRGB8+    black _ _ = PixelRGB8 0 0 0++    img :: DynamicImage+    img = ImageRGB8 (generateImage black 640 480)++    resp :: Text+    resp = decodeUtf8 $ B64.encode $ LB.toStrict $ imageToPng img++  verifyIsActiveSession session_id+  return $ _success_with_value $ String resp+++{- Take Element Screenshot -}++get_session_id_element_id_screenshot+  :: String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_element_id_screenshot session_id element_id = do+  let+    black :: Int -> Int -> PixelRGB8+    black _ _ = PixelRGB8 0 0 0++    img :: DynamicImage+    img = ImageRGB8 (generateImage black 64 48)++    resp :: Text+    resp = decodeUtf8 $ B64.encode $ LB.toStrict $ imageToPng img++  verifyIsActiveSession session_id+  return $ _success_with_value $ String resp++++{---------------------}+{- Success Responses -}+{---------------------}++_success_with_empty_object :: HttpResponse+_success_with_empty_object = _success_with_value $ object []++_success_with_value :: Value -> HttpResponse+_success_with_value v =+  _200ok $ encode $ object [ ("value", v ) ]++++{-------------------}+{- Error Responses -}+{-------------------}++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#handling-errors>.+errorObject :: String -> String -> String -> Maybe String -> SB.ByteString+errorObject err msg stk dat = case dat of+  Nothing -> LB.toStrict $ encode $ object [ ("value", object+    [ ("error", String $ pack err)+    , ("message", String $ pack msg)+    , ("stacktrace", String $ pack stk)+    ] ) ]+  Just txt -> LB.toStrict $ encode $ object [ ("value", object+    [ ("error", String $ pack err)+    , ("message", String $ pack msg)+    , ("stacktrace", String $ pack stk)+    , ("data", object+      [ ("text", String $ pack txt)+      ] )+    ] ) ]++emptyResponse :: Response ()+emptyResponse = Response+  { responseStatus = ok200+  , responseVersion = http11+  , responseHeaders = []+  , responseBody = ()+  , responseCookieJar = CJ []+  , responseClose' = ResponseClose $ return ()+  }++_err_invalid_argument :: String -> HttpException+_err_invalid_argument msg =+  HttpExceptionRequest undefined $ StatusCodeException+    (emptyResponse { responseStatus = badRequest400 })+    (errorObject "invalid argument" msg "" Nothing)++_err_invalid_element_state :: HttpException+_err_invalid_element_state =+  HttpExceptionRequest undefined $ StatusCodeException+    (emptyResponse { responseStatus = badRequest400 })+    (errorObject "invalid element state" "" "" Nothing)++_err_no_such_element :: HttpException+_err_no_such_element =+  HttpExceptionRequest undefined $ StatusCodeException+    (emptyResponse { responseStatus = notFound404 })+    (errorObject "no such element" "" "" Nothing)++_err_invalid_session_id :: HttpException+_err_invalid_session_id =+  HttpExceptionRequest undefined $ StatusCodeException+    (emptyResponse { responseStatus = notFound404 })+    (errorObject "invalid session id" "" "" Nothing)++_err_session_not_created :: HttpException+_err_session_not_created =+  HttpExceptionRequest undefined $ StatusCodeException+    (emptyResponse { responseStatus = internalServerError500 })+    (errorObject "session not created" "" "" Nothing)++_err_unknown_error :: HttpException+_err_unknown_error =+  HttpExceptionRequest undefined $ StatusCodeException+    (emptyResponse { responseStatus = internalServerError500 })+    (errorObject "unknown error" "" "" Nothing)++++parseCssSelector :: String -> MockNetwork WebDriverServerState CssSelector+parseCssSelector str = case parseCss str of+  Left err -> errorMockNetwork (_err_invalid_argument $ show err)+  Right x -> return x++verifyIsActiveSession :: String -> MockNetwork WebDriverServerState ()+verifyIsActiveSession session_id = do+  st <- getMockServer+  if _is_active_session session_id st+    then return ()+    else errorMockNetwork _err_invalid_session_id++getElementFromId :: String -> MockNetwork WebDriverServerState Document+getElementFromId element_id = do+  p <- fmap _current_page getMockServer+  case getElementById element_id p of+    Nothing -> errorMockNetwork _err_no_such_element+    Just doc -> return doc++closeTheSession :: String -> MockNetwork WebDriverServerState ()+closeTheSession session_id =+  modifyMockServer (_delete_session session_id)++getAProperty :: String -> LB.ByteString -> MockNetwork WebDriverServerState String+getAProperty k payload = do+  let v = payload ^? key (pack k) . _String+  case v of+    Nothing -> errorMockNetwork $ _err_invalid_argument (show payload)+    Just value -> return $ unpack value
+ test/Web/Api/WebDriver/Monad/Test/Server/Page.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE RecordWildCards #-}+module Web.Api.WebDriver.Monad.Test.Server.Page (+    HtmlTag(..)+  , Attr(..)+  , Document(Text, tag, attrs, children, elementId)+  , Page(url, contents)+  , buildPage+  , node+  , requestPage+  , CssSelector()+  , getElementById+  , cssMatchDocument+  , parseCss+  , tagIsClearable+  ) where++import Text.ParserCombinators.Parsec+import Data.Monoid+import Data.List+++++data HtmlTag+  = Html+  | Head+  | Title+  | Body+  | Div+  | P+  | Ol+  | Ul+  | Li+  | Form+  | Input+  | Button+  deriving Eq++instance Show HtmlTag where+  show t = case t of+    Html -> "html"; Head -> "head"; Title -> "title"; Body -> "body"+    Div -> "div"; P -> "p"; Ol -> "ol"; Ul -> "ul"; _ -> error "Show HtmlTag"++tagIsClearable :: HtmlTag -> Bool+tagIsClearable t = case t of+  Input -> True+  _ -> False++data Attr+  = Id+  | Class+  | Name+  deriving (Eq, Show)++data Document+  = Text String+  | Document+      { elementId :: String+      , tag :: HtmlTag+      , attrs :: [(Attr, Maybe String)]+      , children :: [Document]+      }+  deriving (Eq, Show)++attrHasValue :: Attr -> String -> Document -> Bool+attrHasValue _ _ (Text _) = False+attrHasValue a v Document{..} =+  case lookup a attrs of+    Just (Just val) -> v == val+    _ -> False++data Page = Page+  { contents :: Document+  , url :: String+  } deriving Show++node :: HtmlTag -> [(Attr, Maybe String)] -> [Document] -> Document+node tag attrs children =+  let elementId = "" in+  Document{..}+++assignIds :: String -> Document -> Document+assignIds _ h@(Text str) = Text str+assignIds base h@Document{..} = h+  { elementId = base+  , children = zipWith prefix [1..] children+  }+  where+    prefix i child = assignIds (base ++ "." ++ show i) child++buildPage :: String -> Document -> Page+buildPage url doc =+  let contents = assignIds "" doc+  in Page{..}++test1 :: Page+test1 = buildPage "example.com" $+  node Html []+    [+    ]+    +++getElementById :: String -> Page -> Maybe Document+getElementById str Page{..} = getFirst $ get contents+  where+    get :: Document -> First Document+    get (Text _) = First Nothing+    get d@Document{..} = if elementId == str+      then First (Just d)+      else mconcat $ map get children++++data CssSelector+  = CssTag HtmlTag+  | CssClass HtmlTag String+  | CssHash HtmlTag String+  | CssAttr HtmlTag Attr String+  deriving Show++pHtmlTag :: Parser HtmlTag+pHtmlTag = choice $ map try+  [ string "html" >> return Html+  , string "head" >> return Head+  , string "title" >> return Title+  , string "body" >> return Body+  , string "div" >> return Div+  , string "p" >> return P+  , string "ol" >> return Ol+  , string "ul" >> return Ul+  , string "li" >> return Li+  , string "form" >> return Form+  , string "input" >> return Input+  , string "button" >> return Button+  ]++pAttr :: Parser Attr+pAttr = choice+  [ string "class" >> return Class+  , string "id" >> return Id+  ]++tokenchar :: Parser String+tokenchar = many1 $ oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['-','_']++pCssSelector :: Parser CssSelector+pCssSelector =+  choice+    [ try $ do+        tag <- pHtmlTag+        char '.'+        classname <- tokenchar+        return (CssClass tag classname)++    , try $ do+        tag <- pHtmlTag+        char '#'+        name <- tokenchar+        return (CssHash tag name)++    , try $ do+        tag <- pHtmlTag+        char '['+        attr <- pAttr+        char '='+        char '\''+        value <- tokenchar+        char '\''+        char ']'+        return (CssAttr tag attr value)++    ] <|> do+      tag <- pHtmlTag+      return (CssTag tag)++parseCss :: String -> Either ParseError CssSelector+parseCss str = parse pCssSelector "" str+++cssMatchDocument :: CssSelector -> Document -> [Document]+cssMatchDocument _ (Text _) = []+cssMatchDocument selector d@Document{..} =+  let+    match = case selector of+      CssTag t -> t == tag+      CssClass t c -> t == tag && attrHasValue Class c d+      CssHash t h -> t == tag && attrHasValue Id h d+      CssAttr t a v -> t == tag && attrHasValue a v d+  in+    (if match then (d:) else id) $+      concatMap (cssMatchDocument selector) children++requestPage :: String -> [Page] -> Maybe Page+requestPage _ [] = Nothing+requestPage path (p@Page{..}:ps) =+  if url == path+    then Just p+    else requestPage path ps
+ test/Web/Api/WebDriver/Monad/Test/Server/State.hs view
@@ -0,0 +1,191 @@+module Web.Api.WebDriver.Monad.Test.Server.State (+    WebDriverServerState()+  , defaultWebDriverServerState+  , _is_active_session+  , _create_session+  , _delete_session+  , _load_page+  , _current_page+  , _go_back+  , _go_forward+  , _get_current_url+  , _get_last_selected_element+  , _set_last_selected_element+  ) where++import Data.List (delete)+import Web.Api.WebDriver.Monad.Test.Server.Page++-- | Models the internal state of a WebDriver remote end.+data WebDriverServerState = WebDriverServerState+  { _next_session_id :: Int++  , _readiness_state :: Bool+  , _active_sessions :: [String]+  , _max_active_sessions :: Int++  , _history :: [Page]+  , _future :: [Page]++  , _last_selected_element :: Maybe String++  , _current_page :: Page+  , _internets :: [Page]+  } deriving Show++defaultWebDriverServerState :: WebDriverServerState+defaultWebDriverServerState = WebDriverServerState+  { _next_session_id = 1++  , _readiness_state = True+  , _active_sessions = []+  , _max_active_sessions = 1++  , _history = []+  , _future = []++  , _last_selected_element = Nothing++  , _current_page = _default_page+  , _internets = []+  }++_is_active_session+  :: String+  -> WebDriverServerState+  -> Bool+_is_active_session str st =+  elem str (_active_sessions st)++_create_session+  :: WebDriverServerState+  -> Maybe (String, WebDriverServerState)+_create_session st =+  if True == _readiness_state st+       && length (_active_sessions st) < _max_active_sessions st+    then+      let+        _id = show $ _next_session_id st+        _st = st+          { _next_session_id =+              1 + (_next_session_id st)+          , _active_sessions =+              _id : _active_sessions st+          , _readiness_state = False+          }+      in Just (_id, _st)+    else Nothing++_delete_session+  :: String+  -> WebDriverServerState+  -> WebDriverServerState+_delete_session str st = st+  { _active_sessions = delete str $ _active_sessions st+  }++_get_current_url+  :: WebDriverServerState+  -> String+_get_current_url =+  url . _current_page++_load_page+  :: String+  -> WebDriverServerState+  -> Maybe WebDriverServerState+_load_page path st = do+  let file = fileOnly path+  p <- if file == "success.html"+    then return _success_page+    else if file == "invalidElementState.html"+      then return _invalidElementState_page+      else requestPage path (_internets st)+  return $ st+    { _current_page = p+    , _history = (_current_page st) : _history st+    }++_go_back+  :: WebDriverServerState+  -> WebDriverServerState+_go_back st = case _history st of+  [] -> st+  p:ps -> st+    { _current_page = p+    , _future = (_current_page st) : _future st+    , _history = ps+    }++_go_forward+  :: WebDriverServerState+  -> WebDriverServerState+_go_forward st = case _future st of+  [] -> st+  p:ps -> st+    { _current_page = p+    , _history = (_current_page st) : _history st+    , _future = ps+    }++_get_last_selected_element+  :: WebDriverServerState+  -> Maybe String+_get_last_selected_element =+  _last_selected_element++_set_last_selected_element+  :: String+  -> WebDriverServerState+  -> WebDriverServerState+_set_last_selected_element elt st = st+  { _last_selected_element = Just elt+  }++_default_page :: Page+_default_page = buildPage "localhost" $+  node Html []+    [ node Head []+        [ node Title []+            [ Text "localhost"+            ]+        ]+    , node Body []+        [+        ]+    ]++_success_page :: Page+_success_page = buildPage "success.html" $+  node Html []+    [ node Head []+        [ node Title []+            [ Text "successes"+            ]+        ]+    , node Body []+        [ node Form []+            [ node P [(Id, Just "super-cool")] []+            , node Button [(Id, Just "alert-button")] []+            , node Button [(Id, Just "confirm-button")] []+            , node Button [(Id, Just "prompt-button")] []+            , node Button [(Id, Just "add-cookie-button")] []+            , node Input [(Name, Just "sometext")] []+            ]+        , node Div [(Class, Just "test")] []+        ]+    ]++_invalidElementState_page :: Page+_invalidElementState_page = buildPage "invalidElementState.html" $+  node Html []+    [ node Head []+        [ node Title []+            [ Text "successes"+            ]+        ]+    , node Body [] []+    ]++fileOnly :: String -> String+fileOnly = reverse . takeWhile (/= '/') . reverse
+ test/Web/Api/WebDriver/Monad/Test/Session/InvalidElementState.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}+module Web.Api.WebDriver.Monad.Test.Session.InvalidElementState (+    invalidElementStateExit+  ) where++import Data.Typeable (Typeable)+import System.IO+++import Web.Api.WebDriver+import Test.Tasty.WebDriver++import qualified Test.Tasty as T+import qualified Test.Tasty.ExpectedFailure as TE+++invalidElementState+  :: (Monad eff)+  => WDError+  -> WebDriver eff ()+invalidElementState e = case e of+  ResponseError InvalidElementState _ _ _ _ -> assertSuccess "yay!"+  err -> assertFailure $+    AssertionComment $ "Expecting 'invalid element state' but got: " ++ show err+++invalidElementStateExit+  :: (Monad eff)+  => (String -> WebDriver eff () -> T.TestTree)+  -> FilePath+  -> T.TestTree+invalidElementStateExit buildTestCase dir =+  let path = dir ++ "/invalidElementState.html" in+  T.testGroup "Invalid Element State"+    [ ifDriverIs Chromedriver TE.ignoreTest $+        buildTestCase "elementClear" (_test_elementClear_invalid_element_state path)+    ]++++_test_elementClear_invalid_element_state+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_elementClear_invalid_element_state page =+  let+    session :: (Monad eff) => WebDriver eff ()+    session = do+      navigateTo page+      !element <- findElement CssSelector "body"+      elementClear element+      throwError $ UnexpectedResult IsSuccess "Expecting 'invalid_element_state'"+      return ()++  in catchError session invalidElementState
+ test/Web/Api/WebDriver/Monad/Test/Session/Success.hs view
@@ -0,0 +1,946 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}+module Web.Api.WebDriver.Monad.Test.Session.Success (+    successfulExit+  ) where++import System.IO++import Web.Api.WebDriver+import Test.Tasty.WebDriver++import qualified Test.Tasty as T+import qualified Test.Tasty.ExpectedFailure as TE+++unexpectedError+  :: (Monad eff)+  => WDError+  -> WebDriver eff ()+unexpectedError e = assertFailure $ AssertionComment $ "Unexpected error:\n" ++ show e+++successfulExit+  :: (Monad eff)+  => (String -> WebDriver eff () -> T.TestTree)+  -> FilePath+  -> T.TestTree+successfulExit buildTestCase dir =+  let path = dir ++ "/success.html" in+  T.testGroup "Successful Exit"+    [ buildTestCase "sessionStatus" (_test_sessionStatus_success path)+    , buildTestCase "getTimeouts" (_test_getTimeouts_success)+    , buildTestCase "setTimeouts" (_test_setTimeouts_success)+    , buildTestCase "navigateTo" (_test_navigateTo_success path)+    , buildTestCase "navigateToStealth" (_test_navigateToStealth_success path)+    , buildTestCase "getCurrentUrl" (_test_getCurrentUrl_success)+    , buildTestCase "goBack" (_test_goBack_success)+    , buildTestCase "goForward" (_test_goForward_success)+    , buildTestCase "pageRefresh" (_test_pageRefresh_success)+    , buildTestCase "getTitle" (_test_getTitle_success)+    , buildTestCase "getWindowHandle" (_test_getWindowHandle_success)+    , buildTestCase "switchToWindow" (_test_switchToWindow_success)+    , buildTestCase "getWindowHandles" (_test_getWindowHandles_success path)+    , buildTestCase "switchToFrame" (_test_switchToFrame_success path)+    , buildTestCase "switchToParentFrame" (_test_switchToParentFrame_success path)+    , buildTestCase "getWindowRect" (_test_getWindowRect_success)+    , buildTestCase "setWindowRect" (_test_setWindowRect_success)+    ,   ifHeadless TE.ignoreTest+      $ buildTestCase "maximizeWindow" (_test_maximizeWindow_success)+    ,   ifHeadless TE.ignoreTest+      $ buildTestCase "minimizeWindow" (_test_minimizeWindow_success)+    ,   ifHeadless TE.ignoreTest+      $ buildTestCase "fullscreenWindow" (_test_fullscreenWindow_success)+    , buildTestCase "findElement" (_test_findElement_success path)+    , buildTestCase "findElements" (_test_findElements_success path)+    , buildTestCase "findElementFromElement" (_test_findElementFromElement_success path)+    , buildTestCase "findElementsFromElement" (_test_findElementsFromElement_success path)+    , buildTestCase "getActiveElement" (_test_getActiveElement_success)+    , buildTestCase "isElementSelected" (_test_isElementSelected_success path)+    , buildTestCase "getElementAttribute" (_test_getElementAttribute_success path)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "getElementCssValue" (_test_getElementCssValue_success path)+    , buildTestCase "getElementText" (_test_getElementText_success path)+    , buildTestCase "getElementTagName" (_test_getElementTagName_success path)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "getElementRect" (_test_getElementRect_success path)+    , buildTestCase "isElementEnabled" (_test_isElementEnabled_success path)+    , buildTestCase "elementClick" (_test_elementClick_success path)+    , buildTestCase "elementClear" (_test_elementClear_success path)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "elementSendKeys" (_test_elementSendKeys_success path)+    , buildTestCase "getPageSource" (_test_getPageSource_success path)+    , buildTestCase "getPageSourceStealth" (_test_getPageSourceStealth_success path)+    , buildTestCase "getAllCookies" (_test_getAllCookies_success path)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "getNamedCookie" (_test_getNamedCookie_success path)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "deleteCookie" (_test_deleteCookie_success path)+    , buildTestCase "deleteAllCookies" (_test_deleteAllCookies_success)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "performActions (keyboard)" (_test_performActions_keyboard_success)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "performActionsStealth (keyboard)" (_test_performActionsStealth_keyboard_success)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "releaseActions" (_test_releaseActions_success)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "dismissAlert" (_test_dismissAlert_success path)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "acceptAlert" (_test_acceptAlert_success path)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ ifHeadless TE.ignoreTest+      $ buildTestCase "getAlertText" (_test_getAlertText_success path)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "sendAlertText" (_test_sendAlertText_success path)+    , buildTestCase "takeScreenshot" (_test_takeScreenshot_success path)+    ,   ifDriverIs Chromedriver TE.ignoreTest+      $ buildTestCase "takeElementScreenshot" (_test_takeElementScreenshot_success path)+    ]++++_test_sessionStatus_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_sessionStatus_success page =+  let+    session = do+      navigateTo page+      (!r,!m) <- sessionStatus+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_getTimeouts_success+  :: (Monad eff) => WebDriver eff ()+_test_getTimeouts_success =+  let+    session = do+      !timeouts <- getTimeouts+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_setTimeouts_success+  :: (Monad eff) => WebDriver eff ()+_test_setTimeouts_success =+  let+    session = do+      () <- setTimeouts emptyTimeoutConfig+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_navigateTo_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_navigateTo_success page =+  let+    session = do+      () <- navigateTo page+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_navigateToStealth_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_navigateToStealth_success page =+  let+    session = do+      () <- navigateToStealth page+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_getCurrentUrl_success+  :: (Monad eff) => WebDriver eff ()+_test_getCurrentUrl_success =+  let+    session = do+      !url <- getCurrentUrl+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_goBack_success+  :: (Monad eff) => WebDriver eff ()+_test_goBack_success =+  let+    session = do+      () <- goBack+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_goForward_success+  :: (Monad eff) => WebDriver eff ()+_test_goForward_success =+  let+    session = do+      () <- goForward+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_pageRefresh_success+  :: (Monad eff) => WebDriver eff ()+_test_pageRefresh_success =+  let+    session = do+      () <- pageRefresh+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_getTitle_success+  :: (Monad eff) => WebDriver eff ()+_test_getTitle_success =+  let+    session = do+      !title <- getTitle+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_getWindowHandle_success+  :: (Monad eff) => WebDriver eff ()+_test_getWindowHandle_success =+  let+    session = do+      !handle <- getWindowHandle+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++-- TODO: closeWindow++++_test_switchToWindow_success+  :: (Monad eff) => WebDriver eff ()+_test_switchToWindow_success =+  let+    session = do+      hs <- getWindowHandles+      case hs of+        [] -> assertFailure "no window handles"+        (!h):_ -> do+          () <- switchToWindow h+          assertSuccess "yay"+          return ()++  in  catchError session unexpectedError++++_test_getWindowHandles_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_getWindowHandles_success page =+  let+    session = do+      navigateTo page+      !handles <- getWindowHandles+      case handles of+        [] -> do+          assertSuccess "yay"+          return ()+        (!x):xs -> do+          assertSuccess "yay"+          return ()++  in  catchError session unexpectedError++++_test_switchToFrame_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_switchToFrame_success page =+  let+    session = do+      navigateTo page+      () <- switchToFrame TopLevelFrame+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_switchToParentFrame_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_switchToParentFrame_success page =+  let+    session = do+      navigateTo page+      () <- switchToParentFrame+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_getWindowRect_success+  :: (Monad eff) => WebDriver eff ()+_test_getWindowRect_success =+  let+    session = do+      !rect <- getWindowRect+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_setWindowRect_success+  :: (Monad eff) => WebDriver eff ()+_test_setWindowRect_success =+  let+    session = do+      !rect <- setWindowRect $ Rect+        { _rectX = 0+        , _rectY = 0+        , _rectWidth = 640+        , _rectHeight = 480+        }+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_maximizeWindow_success+  :: (Monad eff) => WebDriver eff ()+_test_maximizeWindow_success =+  let+    session = do+      !rect <- maximizeWindow+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_minimizeWindow_success+  :: (Monad eff) => WebDriver eff ()+_test_minimizeWindow_success =+  let+    session = do+      !rect <- minimizeWindow+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_fullscreenWindow_success+  :: (Monad eff) => WebDriver eff ()+_test_fullscreenWindow_success =+  let+    session = do+      !rect <- fullscreenWindow+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_findElement_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_findElement_success page =+  let+    session = do+      navigateTo page+      !element <- findElement CssSelector "body"+      !element <- findElement LinkTextSelector "A Link"+      !element <- findElement PartialLinkTextSelector "Link"+      !element <- findElement TagName "body"+      !element <- findElement XPathSelector "*"+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_findElements_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_findElements_success page =+  let+    session = do+      navigateTo page+      !elements <- findElements CssSelector "body"+      case elements of+        [] -> return ()+        (!x):xs -> return ()+      !elements <- findElements LinkTextSelector "Standards"+      case elements of+        [] -> return ()+        (!x):xs -> return ()+      !elements <- findElements PartialLinkTextSelector "Standards"+      case elements of+        [] -> return ()+        (!x):xs -> return ()+      !elements <- findElements TagName "body"+      case elements of+        [] -> return ()+        (!x):xs -> return ()+      !elements <- findElements XPathSelector "*"+      case elements of+        [] -> return ()+        (!x):xs -> return ()+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_findElementFromElement_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_findElementFromElement_success page =+  let+    session = do+      navigateTo page+      root <- findElement CssSelector "body"+      !element <- findElementFromElement CssSelector "p" root+      !element <- findElementFromElement LinkTextSelector "A Link" root+      !element <- findElementFromElement PartialLinkTextSelector "Link" root+      !element <- findElementFromElement TagName "p" root+      !element <- findElementFromElement XPathSelector "*" root+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_findElementsFromElement_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_findElementsFromElement_success page =+  let+    session = do+      navigateTo page+      root <- findElement CssSelector "body"+      !elements <- findElementsFromElement CssSelector "p" root+      case elements of+        [] -> return ()+        (!x):xs -> return ()+      !elements <- findElementsFromElement LinkTextSelector "Standards" root+      case elements of+        [] -> return ()+        (!x):xs -> return ()+      !elements <- findElementsFromElement PartialLinkTextSelector "Standards" root+      case elements of+        [] -> return ()+        (!x):xs -> return ()+      !elements <- findElementsFromElement TagName "p" root+      case elements of+        [] -> return ()+        (!x):xs -> return ()+      !elements <- findElementsFromElement XPathSelector "*" root+      case elements of+        [] -> return ()+        (!x):xs -> return ()+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_getActiveElement_success+  :: (Monad eff) => WebDriver eff ()+_test_getActiveElement_success =+  let+    session = do+      !element <- getActiveElement+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_isElementSelected_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_isElementSelected_success page =+  let+    session = do+      navigateTo page+      !element <- getActiveElement+      !p <- isElementSelected element+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_getElementAttribute_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_getElementAttribute_success page =+  let+    session = do+      navigateTo page+      !element <- getActiveElement+      !attr <- getElementAttribute element "href"+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++-- TODO: getElementProperty++++_test_getElementCssValue_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_getElementCssValue_success page =+  let+    session = do+      navigateTo page+      !element <- findElement CssSelector "p#super-cool"+      !text <- getElementCssValue element "text-decoration"+      case text of+        "none" -> assertSuccess "yay"+        _ -> assertFailure $ AssertionComment $ "expected 'none', got '" ++ text ++ "'"+      return ()++  in  catchError session unexpectedError++++_test_getElementText_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_getElementText_success page =+  let+    session = do+      navigateTo page+      !element <- getActiveElement+      !text <- getElementText element+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_getElementTagName_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_getElementTagName_success page =+  let+    session = do+      navigateTo page+      !element <- findElement CssSelector "div.test"+      !text <- getElementTagName element+      case text of+        "div" -> assertSuccess "yay"+        _ -> assertFailure $ AssertionComment $ "expected 'div', got '" ++ text ++ "'"+      return ()++  in  catchError session unexpectedError++++_test_getElementRect_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_getElementRect_success page =+  let+    session = do+      navigateTo page+      !element <- getActiveElement+      !rect <- getElementRect element+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_isElementEnabled_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_isElementEnabled_success page =+  let+    session = do+      navigateTo page+      !element <- getActiveElement+      !p <- isElementEnabled element+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_elementClick_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_elementClick_success page =+  let+    session = do+      navigateTo page+      !root <- findElement CssSelector "body"+      () <- elementClick root+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_elementClear_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_elementClear_success page =+  let+    session = do+      navigateTo page+      !element <- findElement CssSelector "input[name='sometext']"+      () <- elementClear element+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_elementSendKeys_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_elementSendKeys_success page =+  let+    session = do+      navigateTo page+      !element <- findElement CssSelector "input[name='sometext']"+      () <- elementSendKeys element "foo"+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_getPageSource_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_getPageSource_success page =+  let+    session = do+      navigateTo page+      !src <- getPageSource+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_getPageSourceStealth_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_getPageSourceStealth_success page =+  let+    session = do+      navigateTo page+      !src <- getPageSourceStealth+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++-- TODO: executeScript++++-- TODO: executeAsyncScript++++_test_getAllCookies_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_getAllCookies_success page =+  let+    session = do+      navigateTo page+      !jar <- getAllCookies+      case jar of+        [] -> assertSuccess "yay"+        (!x):_ -> assertFailure "unexpected cookie"+      return ()++  in  catchError session unexpectedError++++_test_getNamedCookie_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_getNamedCookie_success page =+  let+    session = do+      navigateTo page+      findElement CssSelector "button#add-cookie-button" >>= elementClick+      !cookie <- getNamedCookie "fakeCookie"+      assertEqual (_cookieName cookie) (Just "fakeCookie") "cookie name"+      assertEqual (_cookieValue cookie) (Just "fakeValue") "cookie name"+      return ()++  in  catchError session unexpectedError++++{- TODO: addCookie -}+{- note: file:// addresses do not like cookies -}++++_test_deleteCookie_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_deleteCookie_success page =+  let+    session = do+      navigateTo page+      findElement CssSelector "button#add-cookie-button" >>= elementClick+      () <- deleteCookie "fakeCookie"+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_deleteAllCookies_success+  :: (Monad eff) => WebDriver eff ()+_test_deleteAllCookies_success =+  let+    session = do+      () <- deleteAllCookies+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_performActions_keyboard_success+  :: (Monad eff) => WebDriver eff ()+_test_performActions_keyboard_success =+  let+    session = do+      () <- performActions [ press UnidentifiedKey ]+      () <- performActions [ press CancelKey ]+      () <- performActions [ press HelpKey ]+      () <- performActions [ press BackspaceKey ]+      () <- performActions [ press TabKey ]+      () <- performActions [ press ClearKey ]+      () <- performActions [ press ReturnKey ]+      () <- performActions [ press EnterKey ]+      () <- performActions [ press ShiftKey ]+      () <- performActions [ press ControlKey ]+      () <- performActions [ press AltKey ]+      () <- performActions [ press PauseKey ]+      () <- performActions [ press EscapeKey ]+      () <- performActions [ press PageUpKey ]+      () <- performActions [ press PageDownKey ]+      () <- performActions [ press EndKey ]+      () <- performActions [ press HomeKey ]+      () <- performActions [ press ArrowLeftKey ]+      () <- performActions [ press ArrowUpKey ]+      () <- performActions [ press ArrowRightKey ]+      () <- performActions [ press ArrowDownKey ]+      () <- performActions [ press InsertKey ]+      () <- performActions [ press DeleteKey ]+      () <- performActions [ press F1Key ]+      () <- performActions [ press F2Key ]+      () <- performActions [ press F3Key ]+      () <- performActions [ press F4Key ]+      () <- performActions [ press F5Key ]+      () <- performActions [ press F6Key ]+      () <- performActions [ press F7Key ]+      () <- performActions [ press F8Key ]+      () <- performActions [ press F9Key ]+      () <- performActions [ press F10Key ]+      () <- performActions [ press F11Key ]+      () <- performActions [ press F12Key ]+      () <- performActions [ press MetaKey ]+      () <- performActions [ press ZenkakuHankakuKey ]+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_performActionsStealth_keyboard_success+  :: (Monad eff) => WebDriver eff ()+_test_performActionsStealth_keyboard_success =+  let+    session = do+      () <- performActionsStealth [ press EnterKey ]+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_releaseActions_success+  :: (Monad eff) => WebDriver eff ()+_test_releaseActions_success =+  let+    session = do+      () <- releaseActions+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError++++_test_dismissAlert_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_dismissAlert_success page =+  let+    session = do+      navigateTo page+      findElement CssSelector "button#alert-button" >>= elementClick+      () <- dismissAlert+      assertSuccess "yay alert"+      findElement CssSelector "button#confirm-button" >>= elementClick+      () <- dismissAlert+      assertSuccess "yay confirm"+      findElement CssSelector "button#prompt-button" >>= elementClick+      () <- dismissAlert+      assertSuccess "yay prompt"+      return ()++  in  catchError session unexpectedError++++_test_acceptAlert_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_acceptAlert_success page =+  let+    session = do+      navigateTo page+      findElement CssSelector "button#alert-button" >>= elementClick+      () <- acceptAlert+      assertSuccess "yay alert"+      findElement CssSelector "button#confirm-button" >>= elementClick+      () <- acceptAlert+      assertSuccess "yay confirm"+      findElement CssSelector "button#prompt-button" >>= elementClick+      () <- acceptAlert+      assertSuccess "yay prompt"+      return ()++  in  catchError session unexpectedError++++_test_getAlertText_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_getAlertText_success page =+  let+    session = do+      navigateTo page+      findElement CssSelector "button#alert-button" >>= elementClick+      !box <- getAlertText+      case box of+        Nothing -> assertFailure "oh no alert"+        Just msg -> assertEqual msg "WOO!!" "alert text"+      acceptAlert+      findElement CssSelector "button#confirm-button" >>= elementClick+      !box <- getAlertText+      case box of+        Nothing -> assertFailure "oh no confirm"+        Just msg -> assertEqual msg "WOO!!" "confirm text"+      acceptAlert+      findElement CssSelector "button#prompt-button" >>= elementClick+      !box <- getAlertText+      case box of+        Nothing -> assertFailure "oh no prompt"+        Just msg -> assertEqual msg "WOO!!" "prompt text"+      acceptAlert+      return ()++  in  catchError session unexpectedError++++_test_sendAlertText_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_sendAlertText_success page =+  let+    session = do+      navigateTo page+      findElement CssSelector "button#prompt-button" >>= elementClick+      () <- sendAlertText "wut"+      assertSuccess "yay prompt"+      return ()++  in  catchError session unexpectedError++++_test_takeScreenshot_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_takeScreenshot_success page =+  let+    session = do+      navigateTo page+      !screenshot <- takeScreenshot+      assertSuccess "yay"+      return ()++  in catchError session unexpectedError++++_test_takeElementScreenshot_success+  :: (Monad eff) => FilePath -> WebDriver eff ()+_test_takeElementScreenshot_success page =+  let+    session = do+      navigateTo page+      !element <- findElement CssSelector "body"+      !screenshot <- takeElementScreenshot element+      assertSuccess "yay"+      return ()++  in catchError session unexpectedError
+ test/Web/Api/WebDriver/Monad/Test/Session/UnknownError.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}+module Web.Api.WebDriver.Monad.Test.Session.UnknownError (+    unknownErrorExit+  ) where++import Data.Typeable (Typeable)+import System.IO++import Web.Api.WebDriver+import Test.Tasty.WebDriver++import qualified Test.Tasty as T+import qualified Test.Tasty.ExpectedFailure as TE+++unknownError+  :: (Monad eff)+  => WDError+  -> WebDriver eff ()+unknownError e = case e of+  ResponseError UnknownError _ _ _ _ -> assertSuccess "yay!"+  _ -> assertFailure "Expecting 'unknown error'"+++unknownErrorExit+  :: (Monad eff) => (String -> WebDriver eff () -> T.TestTree)+  -> FilePath+  -> T.TestTree+unknownErrorExit buildTestCase path = T.testGroup "Unknown Error"+  [ ifDriverIs Chromedriver TE.ignoreTest $+      buildTestCase "navigateTo" (_test_navigateTo_unknown_error)+  ]++++_test_navigateTo_unknown_error+  :: (Monad eff) => WebDriver eff ()+_test_navigateTo_unknown_error =+  let+    session = do+      navigateTo "https://fake.example"+      throwError $ UnexpectedResult IsSuccess "Expecting 'unknown error'"+      return ()++  in catchError session unknownError
+ test/Web/Api/WebDriver/Types/Test.hs view
@@ -0,0 +1,305 @@+{-# LANGUAGE OverloadedStrings, BangPatterns #-}+module Web.Api.WebDriver.Types.Test (+    tests+  ) where++import Data.Proxy+import qualified Data.Aeson as A+  ( ToJSON(..), FromJSON, fromJSON, Result(..), object, Value(..) )+import Test.QuickCheck+  ( quickCheck, Arbitrary(..), label, Property )++import Test.Tasty (TestTree(), testGroup)+import Test.Tasty.QuickCheck as QC (testProperty)+import Test.Tasty.HUnit as HU++import Web.Api.WebDriver.Types++++tests :: TestTree+tests = testGroup "Web.Api.WebDriver.Types"+  [ test_fromJson_toJson_id+  , test_empty_objects+  , test_fromJson_parse_error+  ]++++-- | Tests the round trip from value to encoded JSON and back.+prop_fromJson_toJson_id+  :: (Eq a, Show a, A.ToJSON a, A.FromJSON a)+  => a -> Bool+prop_fromJson_toJson_id x =+  case A.fromJSON $ A.toJSON x of+    A.Error _ -> False+    A.Success y -> x == y++test_fromJson_toJson_id :: TestTree+test_fromJson_toJson_id = testGroup "fromJSON . toJSON == id"+  [ QC.testProperty "(Capabilities) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: Capabilities -> Bool)++  , QC.testProperty "(BrowserName) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: BrowserName -> Bool)++  , QC.testProperty "(PlatformName) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: PlatformName -> Bool)++  , QC.testProperty "(FirefoxOptions) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: FirefoxOptions -> Bool)++  , QC.testProperty "(ChromeOptions) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: ChromeOptions -> Bool)++  , QC.testProperty "(ProxyConfig) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: ProxyConfig -> Bool)++  , QC.testProperty "(ProxyType) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: ProxyType -> Bool)++  , QC.testProperty "(HostAndOptionalPort) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: HostAndOptionalPort -> Bool)++  , QC.testProperty "(TimeoutConfig) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: TimeoutConfig -> Bool)++  , QC.testProperty "(InputSource) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: InputSource -> Bool)++  , QC.testProperty "(PointerSubtype) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: PointerSubtype -> Bool)++  , QC.testProperty "(InputSourceParameter) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: InputSourceParameter -> Bool)++  , QC.testProperty "(Action) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: Action -> Bool)++  , QC.testProperty "(ActionType) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: ActionType -> Bool)++  , QC.testProperty "(ActionItem) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: ActionItem -> Bool)++  , QC.testProperty "(LocationStrategy) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: LocationStrategy -> Bool)++  , QC.testProperty "(Rect) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: Rect -> Bool)++  , QC.testProperty "(PromptHandler) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: PromptHandler -> Bool)++  , QC.testProperty "(Cookie) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: Cookie -> Bool)++  , QC.testProperty "(ResponseErrorCode) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: ResponseErrorCode -> Bool)+  ]++++-- | Empty objects are equivalent to a parsed "object []".+prop_is_empty_object+  :: (Eq a, Show a, A.ToJSON a)+  => a -> IO ()+prop_is_empty_object x = do+  let obj = A.toJSON x+  if obj == A.object []+    then return ()+    else assertFailure $ "Expected empty object; got " ++ show obj++test_empty_objects :: TestTree+test_empty_objects = testGroup "empty objects"+  [ HU.testCase "emptyCapabilities is an empty object" $+      prop_is_empty_object emptyCapabilities++  , HU.testCase "emptyProxyConfig is an empty object" $+      prop_is_empty_object emptyProxyConfig++  , HU.testCase "emptyTimeoutConfig is an empty object" $+      prop_is_empty_object emptyTimeoutConfig++  , HU.testCase "emptyActionItem is an empty object" $+      prop_is_empty_object emptyActionItem++  , HU.testCase "emptyCookie is an empty object" $+      prop_is_empty_object emptyCookie+  ]++++-- | JSON parse errors.+prop_fromJson_parse_error+  :: (Eq a, Show a, A.FromJSON a)+  => Proxy a -> A.Value -> IO ()+prop_fromJson_parse_error x str =+  case A.fromJSON str of+    A.Error !err -> return ()+    A.Success !y -> do+      let z = asProxyTypeOf y x+      assertFailure $ "Expected parse failure!"++test_fromJson_parse_error :: TestTree+test_fromJson_parse_error = testGroup "JSON parse error expected"+  [ HU.testCase "BrowserName (unrecognized value)" $+      prop_fromJson_parse_error (Proxy :: Proxy BrowserName) $+      A.String "mosaic"++  , HU.testCase "BrowserName (wrong case)" $+      prop_fromJson_parse_error (Proxy :: Proxy BrowserName) $+      A.String "FIREFOX"++  , HU.testCase "BrowserName (wrong type - object)" $+      prop_fromJson_parse_error (Proxy :: Proxy BrowserName) $+      A.object [("browser","firefox")]++  , HU.testCase "BrowserName (wrong type - bool)" $+      prop_fromJson_parse_error (Proxy :: Proxy BrowserName) $+      A.Bool True+++  , HU.testCase "PlatformName (unrecognized value)" $+      prop_fromJson_parse_error (Proxy :: Proxy PlatformName) $+      A.String "os/2"++  , HU.testCase "PlatformName (wrong case)" $+      prop_fromJson_parse_error (Proxy :: Proxy PlatformName) $+      A.String "MAC"++  , HU.testCase "PlatformName (wrong type - object)" $+      prop_fromJson_parse_error (Proxy :: Proxy PlatformName) $+      A.object [("platform","windows")]++  , HU.testCase "PlatformName (wrong type - bool)" $+      prop_fromJson_parse_error (Proxy :: Proxy PlatformName) $+      A.Bool True+++  , HU.testCase "HostAndOptionalPort (malformed value - ':')" $+      prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $+      A.String ":"++  , HU.testCase "HostAndOptionalPort (malformed value - '@:123')" $+      prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $+      A.String "@:123"++  , HU.testCase "HostAndOptionalPort (malformed value - 'host:')" $+      prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $+      A.String "host:"++  , HU.testCase "HostAndOptionalPort (malformed value - 'host:foo')" $+      prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $+      A.String "host:foo"++  , HU.testCase "HostAndOptionalPort (wrong type - object)" $+      prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $+      A.object [("platform","windows")]++  , HU.testCase "HostAndOptionalPort (wrong type - bool)" $+      prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $+      A.Bool True+++  , HU.testCase "ProxyType (unrecognized value)" $+      prop_fromJson_parse_error (Proxy :: Proxy ProxyType) $+      A.String "lan"++  , HU.testCase "ProxyType (wrong case)" $+      prop_fromJson_parse_error (Proxy :: Proxy ProxyType) $+      A.String "PAC"++  , HU.testCase "ProxyType (wrong type - object)" $+      prop_fromJson_parse_error (Proxy :: Proxy ProxyType) $+      A.object [("proxy","what")]++  , HU.testCase "ProxyType (wrong type - bool)" $+      prop_fromJson_parse_error (Proxy :: Proxy ProxyType) $+      A.Bool True+++  , HU.testCase "LocationStrategy (unrecognized value)" $+      prop_fromJson_parse_error (Proxy :: Proxy LocationStrategy) $+      A.String "tag"++  , HU.testCase "LocationStrategy (wrong case)" $+      prop_fromJson_parse_error (Proxy :: Proxy LocationStrategy) $+      A.String "CSS Selector"++  , HU.testCase "LocationStrategy (wrong type - object)" $+      prop_fromJson_parse_error (Proxy :: Proxy LocationStrategy) $+      A.object [("css","selector")]++  , HU.testCase "LocationStrategy (wrong type - bool)" $+      prop_fromJson_parse_error (Proxy :: Proxy LocationStrategy) $+      A.Bool True+++  , HU.testCase "InputSource (unrecognized value)" $+      prop_fromJson_parse_error (Proxy :: Proxy InputSource) $+      A.String "keyboard"++  , HU.testCase "InputSource (wrong case)" $+      prop_fromJson_parse_error (Proxy :: Proxy InputSource) $+      A.String "NULL"++  , HU.testCase "InputSource (wrong type - object)" $+      prop_fromJson_parse_error (Proxy :: Proxy InputSource) $+      A.object [("key","board")]++  , HU.testCase "InputSource (wrong type - bool)" $+      prop_fromJson_parse_error (Proxy :: Proxy InputSource) $+      A.Bool True+++  , HU.testCase "PointerSubtype (unrecognized value)" $+      prop_fromJson_parse_error (Proxy :: Proxy PointerSubtype) $+      A.String "stylus"++  , HU.testCase "PointerSubtype (wrong case)" $+      prop_fromJson_parse_error (Proxy :: Proxy PointerSubtype) $+      A.String "Mouse"++  , HU.testCase "PointerSubtype (wrong type - object)" $+      prop_fromJson_parse_error (Proxy :: Proxy PointerSubtype) $+      A.object [("track","pad")]++  , HU.testCase "PointerSubtype (wrong type - bool)" $+      prop_fromJson_parse_error (Proxy :: Proxy PointerSubtype) $+      A.Bool True+++  , HU.testCase "ActionType (unrecognized value)" $+      prop_fromJson_parse_error (Proxy :: Proxy ActionType) $+      A.String "keypress"++  , HU.testCase "ActionType (wrong case)" $+      prop_fromJson_parse_error (Proxy :: Proxy ActionType) $+      A.String "Pause"++  , HU.testCase "ActionType (wrong type - object)" $+      prop_fromJson_parse_error (Proxy :: Proxy ActionType) $+      A.object [("click","button")]++  , HU.testCase "ActionType (wrong type - bool)" $+      prop_fromJson_parse_error (Proxy :: Proxy ActionType) $+      A.Bool True+++  , HU.testCase "PromptHandler (unrecognized value)" $+      prop_fromJson_parse_error (Proxy :: Proxy PromptHandler) $+      A.String "check"++  , HU.testCase "PromptHandler (wrong case)" $+      prop_fromJson_parse_error (Proxy :: Proxy PromptHandler) $+      A.String "Dismiss"++  , HU.testCase "PromptHandler (wrong type - object)" $+      prop_fromJson_parse_error (Proxy :: Proxy PromptHandler) $+      A.object [("accept","alert")]++  , HU.testCase "PromptHandler (wrong type - bool)" $+      prop_fromJson_parse_error (Proxy :: Proxy PromptHandler) $+      A.Bool True+  ]
+ webdriver-w3c.cabal view
@@ -0,0 +1,166 @@+name:           webdriver-w3c+version:        0.0.1+description:    Please see the README on Github at <https://github.com/nbloomf/webdriver-w3c#readme>+homepage:       https://github.com/nbloomf/webdriver-w3c#readme+bug-reports:    https://github.com/nbloomf/webdriver-w3c/issues+author:         Nathan Bloomfield+maintainer:     nathan.bloomfield@a8c.com+copyright:      2018 Automattic, Inc.+license:        GPL-3+license-file:   LICENSE+build-type:     Simple+cabal-version:  1.20+category:       web, webdriver, testing+synopsis:       Bindings to the WebDriver API++extra-source-files:+  ChangeLog.md+  README.md++source-repository head+  type: git+  location: https://github.com/nbloomf/webdriver-w3c++++library+  default-language: Haskell2010+  hs-source-dirs: src+  ghc-options:+    -fwarn-incomplete-patterns++  build-depends:+      base >=4.7 && <5++    , aeson >=1.2.4.0 && <1.3+    , aeson-pretty >=0.8.5 && <0.9+    , base64-bytestring >=1.0.0.1 && <1.1+    , bytestring >=0.10.8.2 && <0.11+    , containers >=0.5.10.2 && <0.6+    , directory >=1.3.0.2 && <1.4+    , exceptions >=0.8.3 && <0.9+    , http-client >=0.5.10 && <0.6+    , http-types >=0.12.1 && <0.13+    , JuicyPixels >=3.2.9.4 && <3.3+    , lens >=4.16 && <4.17+    , lens-aeson >=1.0.2 && <1.1+    , network-uri >= 2.6 && < 2.7+    , QuickCheck >=2.10.1 && <2.11+    , random >=1.1 && <1.2+    , scientific >=0.3.5.2 && <0.4+    , script-monad >=0.0.1 && <0.0.2+    , SHA >=1.6.4.2 && <1.7+    , stm >=2.4.5.0 && <2.5+    , tasty >=1.0.1.1 && <1.1+    , tasty-expected-failure >=0.11.1.1 && <0.12+    , text >=1.2.3.0 && <1.3+    , time >=1.8.0.2 && <1.9+    , unordered-containers >=0.2.9.0 && <0.3+    , uri-encode >=1.5.0.5 && <1.6+    , vector >=0.12.0.1 && <0.13+    , wreq >=0.5.2 && <0.6++  exposed-modules:+    Test.Tasty.WebDriver+    Test.Tasty.WebDriver.Config+    Web.Api.WebDriver.Assert+    Web.Api.WebDriver+    Web.Api.WebDriver.Classes+    Web.Api.WebDriver.Endpoints+    Web.Api.WebDriver.Helpers+    Web.Api.WebDriver.Monad+    Web.Api.WebDriver.Types+    Web.Api.WebDriver.Types.Keyboard+    Web.Api.WebDriver.Uri++++executable webdriver-w3c-intro+  default-language: Haskell2010+  main-is: Main.lhs+  hs-source-dirs: app+  ghc-options:+    -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      webdriver-w3c+    , base >=4.7 && <5++    , tasty >=1.0.1.1 && <1.1++++executable wd-tasty-demo+  default-language: Haskell2010+  main-is: TastyDemo.lhs+  hs-source-dirs: app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      webdriver-w3c+    , base >=4.7 && <5++    , tasty >=1.0.1.1 && <1.1+    , tasty-expected-failure >=0.11.1.1 && <0.12++++executable wd-parallel-stress-test+  default-language: Haskell2010+  main-is: ParallelStressTest.hs+  hs-source-dirs: app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      webdriver-w3c+    , base >=4.7 && <5++    , tasty >=1.0.1.1 && <1.1++++test-suite webdriver-w3c-test+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test+  ghc-options:+    -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      webdriver-w3c+    , base >=4.7 && <5++    , aeson >=1.2.4.0 && <1.3+    , base64-bytestring >=1.0.0.1 && <1.1+    , bytestring >=0.10.8.2 && <0.11+    , containers >=0.5.10.2 && <0.6+    , directory >=1.3.0.2 && <1.4+    , exceptions >=0.8.3 && <0.9+    , http-client >=0.5.10 && <0.6+    , http-types >=0.12.1 && <0.13+    , JuicyPixels >=3.2.9.4 && <3.3+    , lens >=4.16 && <4.17+    , lens-aeson >=1.0.2 && <1.1+    , parsec >=3.1.13.0 && <4+    , QuickCheck >=2.10.1 && <2.11+    , random >=1.1 && <1.2+    , unordered-containers >=0.2.9.0 && <0.3+    , scientific >=0.3.5.2 && <0.4+    , script-monad >=0.0.1 && <0.0.2+    , tasty >=1.0.1.1 && <1.1+    , tasty-expected-failure >=0.11.1.1 && <0.12+    , tasty-hunit >=0.10.0.1 && <0.11+    , tasty-quickcheck >=0.9.2 && <1.0+    , time >=1.8.0.2 && <1.9+    , text >=1.2.3.0 && <1.3+    , vector >=0.12.0.1 && <1.0+    , wreq >=0.5.2 && <0.6++  other-modules:+    Test.Tasty.WebDriver.Config.Test+    Web.Api.WebDriver.Assert.Test+    Web.Api.WebDriver.Monad.Test+    Web.Api.WebDriver.Monad.Test.Server+    Web.Api.WebDriver.Monad.Test.Server.Page+    Web.Api.WebDriver.Monad.Test.Server.State+    Web.Api.WebDriver.Monad.Test.Session.Success+    Web.Api.WebDriver.Monad.Test.Session.InvalidElementState+    Web.Api.WebDriver.Monad.Test.Session.UnknownError+    Web.Api.WebDriver.Types.Test