marionette-effectful (empty) → 1.0.0
raw patch · 6 files changed
+1005/−0 lines, 6 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, effectful, hspec-effectful, http-types, lucid2, marionette, marionette-effectful, mtl, text, typed-process-effectful, unliftio, wai, warp
Files
- CHANGELOG.md +12/−0
- LICENCE +287/−0
- Setup.hs +2/−0
- marionette-effectful.cabal +89/−0
- src/Effectful/Marionette.hs +137/−0
- test/Main.hs +478/−0
+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),+and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/).++## [1.0.0] - 2026-07-14++### Added++- Initial release.
+ LICENCE view
@@ -0,0 +1,287 @@+ EUROPEAN UNION PUBLIC LICENCE v. 1.2+ EUPL © the European Union 2007, 2016++This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined+below) which is provided under the terms of this Licence. Any use of the Work,+other than as authorised under this Licence is prohibited (to the extent such+use is covered by a right of the copyright holder of the Work).++The Work is provided under the terms of this Licence when the Licensor (as+defined below) has placed the following notice immediately following the+copyright notice for the Work:++ Licensed under the EUPL++or has expressed by any other means his willingness to license under the EUPL.++1. Definitions++In this Licence, the following terms have the following meaning:++- ‘The Licence’: this Licence.++- ‘The Original Work’: the work or software distributed or communicated by the+ Licensor under this Licence, available as Source Code and also as Executable+ Code as the case may be.++- ‘Derivative Works’: the works or software that could be created by the+ Licensee, based upon the Original Work or modifications thereof. This Licence+ does not define the extent of modification or dependence on the Original Work+ required in order to classify a work as a Derivative Work; this extent is+ determined by copyright law applicable in the country mentioned in Article 15.++- ‘The Work’: the Original Work or its Derivative Works.++- ‘The Source Code’: the human-readable form of the Work which is the most+ convenient for people to study and modify.++- ‘The Executable Code’: any code which has generally been compiled and which is+ meant to be interpreted by a computer as a program.++- ‘The Licensor’: the natural or legal person that distributes or communicates+ the Work under the Licence.++- ‘Contributor(s)’: any natural or legal person who modifies the Work under the+ Licence, or otherwise contributes to the creation of a Derivative Work.++- ‘The Licensee’ or ‘You’: any natural or legal person who makes any usage of+ the Work under the terms of the Licence.++- ‘Distribution’ or ‘Communication’: any act of selling, giving, lending,+ renting, distributing, communicating, transmitting, or otherwise making+ available, online or offline, copies of the Work or providing access to its+ essential functionalities at the disposal of any other natural or legal+ person.++2. Scope of the rights granted by the Licence++The Licensor hereby grants You a worldwide, royalty-free, non-exclusive,+sublicensable licence to do the following, for the duration of copyright vested+in the Original Work:++- use the Work in any circumstance and for all usage,+- reproduce the Work,+- modify the Work, and make Derivative Works based upon the Work,+- communicate to the public, including the right to make available or display+ the Work or copies thereof to the public and perform publicly, as the case may+ be, the Work,+- distribute the Work or copies thereof,+- lend and rent the Work or copies thereof,+- sublicense rights in the Work or copies thereof.++Those rights can be exercised on any media, supports and formats, whether now+known or later invented, as far as the applicable law permits so.++In the countries where moral rights apply, the Licensor waives his right to+exercise his moral right to the extent allowed by law in order to make effective+the licence of the economic rights here above listed.++The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to+any patents held by the Licensor, to the extent necessary to make use of the+rights granted on the Work under this Licence.++3. Communication of the Source Code++The Licensor may provide the Work either in its Source Code form, or as+Executable Code. If the Work is provided as Executable Code, the Licensor+provides in addition a machine-readable copy of the Source Code of the Work+along with each copy of the Work that the Licensor distributes or indicates, in+a notice following the copyright notice attached to the Work, a repository where+the Source Code is easily and freely accessible for as long as the Licensor+continues to distribute or communicate the Work.++4. Limitations on copyright++Nothing in this Licence is intended to deprive the Licensee of the benefits from+any exception or limitation to the exclusive rights of the rights owners in the+Work, of the exhaustion of those rights or of other applicable limitations+thereto.++5. Obligations of the Licensee++The grant of the rights mentioned above is subject to some restrictions and+obligations imposed on the Licensee. Those obligations are the following:++Attribution right: The Licensee shall keep intact all copyright, patent or+trademarks notices and all notices that refer to the Licence and to the+disclaimer of warranties. The Licensee must include a copy of such notices and a+copy of the Licence with every copy of the Work he/she distributes or+communicates. The Licensee must cause any Derivative Work to carry prominent+notices stating that the Work has been modified and the date of modification.++Copyleft clause: If the Licensee distributes or communicates copies of the+Original Works or Derivative Works, this Distribution or Communication will be+done under the terms of this Licence or of a later version of this Licence+unless the Original Work is expressly distributed only under this version of the+Licence — for example by communicating ‘EUPL v. 1.2 only’. The Licensee+(becoming Licensor) cannot offer or impose any additional terms or conditions on+the Work or Derivative Work that alter or restrict the terms of the Licence.++Compatibility clause: If the Licensee Distributes or Communicates Derivative+Works or copies thereof based upon both the Work and another work licensed under+a Compatible Licence, this Distribution or Communication can be done under the+terms of this Compatible Licence. For the sake of this clause, ‘Compatible+Licence’ refers to the licences listed in the appendix attached to this Licence.+Should the Licensee's obligations under the Compatible Licence conflict with+his/her obligations under this Licence, the obligations of the Compatible+Licence shall prevail.++Provision of Source Code: When distributing or communicating copies of the Work,+the Licensee will provide a machine-readable copy of the Source Code or indicate+a repository where this Source will be easily and freely available for as long+as the Licensee continues to distribute or communicate the Work.++Legal Protection: This Licence does not grant permission to use the trade names,+trademarks, service marks, or names of the Licensor, except as required for+reasonable and customary use in describing the origin of the Work and+reproducing the content of the copyright notice.++6. Chain of Authorship++The original Licensor warrants that the copyright in the Original Work granted+hereunder is owned by him/her or licensed to him/her and that he/she has the+power and authority to grant the Licence.++Each Contributor warrants that the copyright in the modifications he/she brings+to the Work are owned by him/her or licensed to him/her and that he/she has the+power and authority to grant the Licence.++Each time You accept the Licence, the original Licensor and subsequent+Contributors grant You a licence to their contributions to the Work, under the+terms of this Licence.++7. Disclaimer of Warranty++The Work is a work in progress, which is continuously improved by numerous+Contributors. It is not a finished work and may therefore contain defects or+‘bugs’ inherent to this type of development.++For the above reason, the Work is provided under the Licence on an ‘as is’ basis+and without warranties of any kind concerning the Work, including without+limitation merchantability, fitness for a particular purpose, absence of defects+or errors, accuracy, non-infringement of intellectual property rights other than+copyright as stated in Article 6 of this Licence.++This disclaimer of warranty is an essential part of the Licence and a condition+for the grant of any rights to the Work.++8. Disclaimer of Liability++Except in the cases of wilful misconduct or damages directly caused to natural+persons, the Licensor will in no event be liable for any direct or indirect,+material or moral, damages of any kind, arising out of the Licence or of the use+of the Work, including without limitation, damages for loss of goodwill, work+stoppage, computer failure or malfunction, loss of data or any commercial+damage, even if the Licensor has been advised of the possibility of such damage.+However, the Licensor will be liable under statutory product liability laws as+far such laws apply to the Work.++9. Additional agreements++While distributing the Work, You may choose to conclude an additional agreement,+defining obligations or services consistent with this Licence. However, if+accepting obligations, You may act only on your own behalf and on your sole+responsibility, not on behalf of the original Licensor or any other Contributor,+and only if You agree to indemnify, defend, and hold each Contributor harmless+for any liability incurred by, or claims asserted against such Contributor by+the fact You have accepted any warranty or additional liability.++10. Acceptance of the Licence++The provisions of this Licence can be accepted by clicking on an icon ‘I agree’+placed under the bottom of a window displaying the text of this Licence or by+affirming consent in any other similar way, in accordance with the rules of+applicable law. Clicking on that icon indicates your clear and irrevocable+acceptance of this Licence and all of its terms and conditions.++Similarly, you irrevocably accept this Licence and all of its terms and+conditions by exercising any rights granted to You by Article 2 of this Licence,+such as the use of the Work, the creation by You of a Derivative Work or the+Distribution or Communication by You of the Work or copies thereof.++11. Information to the public++In case of any Distribution or Communication of the Work by means of electronic+communication by You (for example, by offering to download the Work from a+remote location) the distribution channel or media (for example, a website) must+at least provide to the public the information requested by the applicable law+regarding the Licensor, the Licence and the way it may be accessible, concluded,+stored and reproduced by the Licensee.++12. Termination of the Licence++The Licence and the rights granted hereunder will terminate automatically upon+any breach by the Licensee of the terms of the Licence.++Such a termination will not terminate the licences of any person who has+received the Work from the Licensee under the Licence, provided such persons+remain in full compliance with the Licence.++13. Miscellaneous++Without prejudice of Article 9 above, the Licence represents the complete+agreement between the Parties as to the Work.++If any provision of the Licence is invalid or unenforceable under applicable+law, this will not affect the validity or enforceability of the Licence as a+whole. Such provision will be construed or reformed so as necessary to make it+valid and enforceable.++The European Commission may publish other linguistic versions or new versions of+this Licence or updated versions of the Appendix, so far this is required and+reasonable, without reducing the scope of the rights granted by the Licence. New+versions of the Licence will be published with a unique version number.++All linguistic versions of this Licence, approved by the European Commission,+have identical value. Parties can take advantage of the linguistic version of+their choice.++14. Jurisdiction++Without prejudice to specific agreement between parties,++- any litigation resulting from the interpretation of this License, arising+ between the European Union institutions, bodies, offices or agencies, as a+ Licensor, and any Licensee, will be subject to the jurisdiction of the Court+ of Justice of the European Union, as laid down in article 272 of the Treaty on+ the Functioning of the European Union,++- any litigation arising between other parties and resulting from the+ interpretation of this License, will be subject to the exclusive jurisdiction+ of the competent court where the Licensor resides or conducts its primary+ business.++15. Applicable Law++Without prejudice to specific agreement between parties,++- this Licence shall be governed by the law of the European Union Member State+ where the Licensor has his seat, resides or has his registered office,++- this licence shall be governed by Belgian law if the Licensor has no seat,+ residence or registered office inside a European Union Member State.++Appendix++‘Compatible Licences’ according to Article 5 EUPL are:++- GNU General Public License (GPL) v. 2, v. 3+- GNU Affero General Public License (AGPL) v. 3+- Open Software License (OSL) v. 2.1, v. 3.0+- Eclipse Public License (EPL) v. 1.0+- CeCILL v. 2.0, v. 2.1+- Mozilla Public Licence (MPL) v. 2+- GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3+- Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for+ works other than software+- European Union Public Licence (EUPL) v. 1.1, v. 1.2+- Québec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong+ Reciprocity (LiLiQ-R+).++The European Commission may update this Appendix to later versions of the above+licences without producing a new version of the EUPL, as long as they provide+the rights granted in Article 2 of this Licence and protect the covered Source+Code from exclusive appropriation.++All other changes or additions to this Appendix require the production of a new+EUPL version.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ marionette-effectful.cabal view
@@ -0,0 +1,89 @@+cabal-version: 3.0+name: marionette-effectful+version: 1.0.0+category: Web+synopsis: Effectful driver for Marionette+description:+ Adaptation of the @<https://hackage.haskell.org/package/marionette marionette>@ library for the @<https://hackage.haskell.org/package/effectful effectful>@ ecosystem.++license: EUPL-1.2+license-file: LICENCE+author: IDA+maintainer: IDA+homepage: https://digital-autonomy.institute+bug-reports: https://issues.digital-autonomy.institute+build-type: Simple+extra-doc-files:+ CHANGELOG.md++common common+ default-language: Haskell2010+ ghc-options:+ -Weverything+ -Wno-unsafe+ -Wno-missing-safe-haskell-mode+ -Wno-missing-export-lists+ -Wno-missing-import-lists+ -Wno-missing-kind-signatures+ -Wno-all-missed-specialisations++ default-extensions:+ ApplicativeDo+ BlockArguments+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DeriveGeneric+ DerivingStrategies+ DerivingVia+ ExplicitNamespaces+ FlexibleContexts+ ImportQualifiedPost+ LambdaCase+ MultiParamTypeClasses+ NamedFieldPuns+ NoImplicitPrelude+ OverloadedLabels+ OverloadedRecordDot+ OverloadedStrings+ RankNTypes+ RecordWildCards+ RecursiveDo+ ScopedTypeVariables+ TypeApplications+ TypeFamilies+ TypeOperators+ ViewPatterns++ build-depends:+ base >=4.16 && <5,+ effectful >=2.6 && <2.7,+ marionette >=1.0 && <1.1,++library+ import: common+ hs-source-dirs: src+ build-depends:+ mtl >=2.3 && <2.4,+ unliftio >=0.2 && <0.3,++ exposed-modules:+ Effectful.Marionette++test-suite marionette-effectful-test+ import: common+ type: exitcode-stdio-1.0+ ghc-options: -threaded+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ aeson >=2.2 && <2.3,+ bytestring >=0.12 && <0.13,+ hspec-effectful >=1.0 && <1.1,+ http-types >=0.12 && <0.13,+ lucid2 >=0.0 && <0.1,+ marionette-effectful,+ text >=2.1 && <2.2,+ typed-process-effectful >=1.0 && <1.1,+ wai >=3.2 && <3.3,+ warp >=3.4 && <3.5,
+ src/Effectful/Marionette.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-missing-role-annotations #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module : Effectful.Marionette+-- Copyright : (c) 2026 Institute for Digital Autonomy+-- License : EUPL-1.2+-- Maintainer : IDA+--+-- <https://firefox-source-docs.mozilla.org/testing/marionette/ Marionette> is+-- Firefox's built-in remote-control protocol. It plays the same role as a+-- <https://www.w3.org/TR/webdriver/ WebDriver> server, letting a test suite+-- drive a real Firefox instance to navigate, find and interact with+-- elements, execute scripts, and so on. In addition to WebDriver functionality,+-- Marionette can also address Firefox's own chrome (its menus and toolbars)+-- rather than just the content of a web page, and speaks its own lightweight+-- length-prefixed JSON protocol directly over a TCP socket instead of+-- HTTP.+--+-- This module lifts every command from the+-- <https://hackage.haskell.org/package/marionette marionette> library into+-- the 'Eff' monad as a 'Marionette' effect. Run 'runMarionette' to open the+-- connection and discharge that effect for the duration of your action.+--+-- = How to use Marionette+--+-- == Starting Firefox and a session+--+-- Launch Firefox with the @--marionette@ flag so that it listens for+-- connections on port 2828.+--+-- Use 'runMarionette' to connect to it and run a client program.+-- Start a new session with 'newSession', and quit the session with 'quit':+--+-- > import Effectful+-- > import Effectful.Marionette+-- > import Effectful.Process.Typed+-- > import System.Process.Typed (proc)+-- >+-- > main :: IO ()+-- > main =+-- > runEff . runTypedProcess $+-- > withProcessTerm_ (proc "firefox" ["--marionette", "--headless"]) \_process ->+-- > runMarionette $ do+-- > newSession+-- > -- More Marionette actions go here+-- > quit+--+-- Most Marionette actions need to be performed in a session.+--+-- == Finding and interacting with elements+--+-- Find elements by calling 'findElement' with a 'Selector',+-- then pass the resulting 'Element' to other commands:+--+-- > submitForm :: (HasCallStack, Marionette :> es) => Eff es ()+-- > submitForm = do+-- > input <- findElement (ById "text-input")+-- > elementSendKeys input "hello, world"+-- > submit <- findElement (ByCSS "button[type=submit]")+-- > elementClick submit+--+-- == Error handling+--+-- Catch command failures using @Effectful.Exception@,+-- for example to retry a command against a fallback element:+--+-- > import Effectful.Exception (catchError)+-- >+-- > clickFirstAvailable :: (HasCallStack, Marionette :> es) => Eff es ()+-- > clickFirstAvailable =+-- > (elementClick =<< findElement (ById "primary-button"))+-- > `catchError` \_ -> elementClick =<< findElement (ById "fallback-button")+module Effectful.Marionette+ ( -- * Effect+ Marionette+ , runMarionette++ -- * Re-exports from @Marionette@+ , module Test.Marionette+ )+where++import Control.Monad.Error.Class (MonadError (..))+import Effectful+ ( Dispatch (Static)+ , DispatchOf+ , Eff+ , Effect+ , IOE+ , Limit (..)+ , Persistence (Ephemeral)+ , UnliftStrategy (ConcUnlift)+ , withEffToIO+ , (:>)+ )+import Effectful.Dispatch.Static+ ( SideEffects (WithSideEffects)+ , StaticRep+ , evalStaticRep+ , getStaticRep+ , unsafeEff_+ )+import Effectful.Exception (catch, throwIO)+import Test.Marionette hiding (Marionette)+import Test.Marionette qualified as Marionette+import Test.Marionette.Class qualified as Marionette+import UnliftIO (withRunInIO)+import Prelude++data Marionette :: Effect++type instance DispatchOf Marionette = 'Static 'WithSideEffects++newtype instance StaticRep Marionette = Marionette (forall a. MarionetteT IO a -> IO a)++instance {-# OVERLAPPING #-} MonadError Marionette.Error (Eff es) where+ throwError = throwIO+ catchError = catch++instance (Marionette :> es) => Marionette.Marionette (Eff es) where+ sendCommands commands = do+ Marionette unlift <- getStaticRep+ unsafeEff_ . unlift $ Marionette.sendCommands commands++-- | Connect to a Marionette server listening on @localhost:2828@ (started+-- by launching Firefox with the @--marionette@ flag), and run the given+-- action against it.+runMarionette+ :: (IOE :> es)+ => Eff (Marionette ': es) a+ -> Eff es a+runMarionette action =+ withEffToIO (ConcUnlift Ephemeral Unlimited) \unlift -> runMarionetteT $+ withRunInIO \runInIO -> unlift . evalStaticRep (Marionette runInIO) $ action
+ test/Main.hs view
@@ -0,0 +1,478 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module Main where++import Data.Aeson (toJSON)+import Data.ByteString qualified as ByteString+import Data.Functor (void)+import Data.Text (Text)+import Data.Text qualified as Text+import Effectful+import Effectful.Concurrent (Concurrent, forkIO, killThread, runConcurrent)+import Effectful.Exception (bracket)+import Effectful.Hspec+import Effectful.Marionette+import Effectful.Process.Typed+ ( checkExitCode+ , nullStream+ , proc+ , runTypedProcess+ , setStderr+ , setStdout+ , startProcess+ )+import Lucid+import Network.HTTP.Types (status200)+import Network.Wai (Application, rawPathInfo, responseLBS)+import Network.Wai.Handler.Warp (run)+import Test.Marionette.Cookie qualified as Cookie+import Test.Marionette.Rect qualified as Rect+import Test.Marionette.Timeouts qualified as Timeouts+import Test.Marionette.WebAuthn qualified as WebAuthn+import Prelude hiding (print)++page :: Text -> Html () -> Html ()+page title body =+ html_ do+ head_ $ title_ (toHtml title)+ body_ body++app :: Application+app req respond =+ respond+ . responseLBS status200 [("Content-Type", "text/html")]+ . renderBS+ $ case rawPathInfo req of+ "/form" ->+ page "Form Page" do+ form_ do+ input_ [id_ "text-input", type_ "text", name_ "q"]+ input_ [id_ "checkbox", type_ "checkbox", name_ "check"]+ select_ [id_ "select"] do+ option_ [value_ "a"] "Option A"+ option_ [value_ "b"] "Option B"+ button_ [id_ "submit", type_ "submit"] "Submit"+ "/link" ->+ page "Link Page" do+ a_ [id_ "link", href_ "/target"] "Click me"+ a_ [id_ "partial", href_ "/target"] "Click here for more"+ "/target" ->+ page "Target Page" do+ p_ [id_ "result"] "You arrived!"+ "/shadow" ->+ page "Shadow DOM Page" do+ div_ [id_ "host"] mempty+ script_+ "\+ \const host = document.getElementById('host');\+ \const shadow = host.attachShadow({mode: 'open'});\+ \shadow.innerHTML = '<p id=\"shadow-p\">Shadow content</p>';"+ "/alert" ->+ page "Alert Page" do+ button_ [id_ "alert-btn", onclick_ "alert('Hello!')"] "Alert"+ button_ [id_ "confirm-btn", onclick_ "confirm('Sure?')"] "Confirm"+ button_ [id_ "prompt-btn", onclick_ "prompt('Input:')"] "Prompt"+ _ ->+ page "Marionette Test" do+ h1_ [id_ "heading"] "Hello, Marionette!"+ p_ [id_ "para", class_ "content"] "Test paragraph"+ p_ [id_ "para2", class_ "content"] "Second paragraph"+ div_ [id_ "parent"] do+ span_ [id_ "child"] "Child element"++runTestServer :: (IOE :> es, Concurrent :> es) => Eff es a -> Eff es a+runTestServer = bracket (forkIO . liftIO $ run 8080 app) killThread . const++runFirefox :: (IOE :> es) => Eff es a -> Eff es a+runFirefox =+ runTypedProcess+ . bracket+ ( startProcess+ . setStdout nullStream+ . setStderr nullStream+ . proc "firefox"+ $ [ "--marionette"+ , "--headless"+ , "-remote-allow-system-access"+ ]+ )+ ( \process -> do+ runMarionette $ newSession >> quit+ checkExitCode process+ )+ . const+ . inject++run' :: (IOE :> es) => Eff (Marionette ': es) () -> Eff es ()+run' action = runMarionette do+ newSession+ navigate "http://localhost:8080/"+ action+ deleteSession++main :: IO ()+main = runEff . runConcurrent . runTestServer . runFirefox . runHspec $ do+ describe "Session" do+ it "can create and delete a session" . run' $ do+ deleteSession+ newSession++ describe "Navigation" do+ it "navigates to a URL" . run' $ getCurrentURL `shouldReturn` "http://localhost:8080/"++ it "can go back and forward" . run' $ do+ navigate "http://localhost:8080/target"+ back+ getCurrentURL `shouldReturn` "http://localhost:8080/"+ forward+ getCurrentURL `shouldReturn` "http://localhost:8080/target"++ it "can refresh" . run' $ do+ refresh+ getCurrentURL `shouldReturn` "http://localhost:8080/"++ it "getTitle returns page title" . run' $ getTitle `shouldReturn` "Marionette Test"++ it "getPageSource returns HTML" . run' $ do+ source <- getPageSource+ source `shouldSatisfy` Text.isInfixOf "Hello, Marionette!"++ it "getCurrentURL returns current URL"+ . run'+ $ getCurrentURL+ `shouldReturn` "http://localhost:8080/"++ describe "Timeouts" do+ it "setTimeouts / getTimeouts roundtrip" . run' $ do+ let t =+ Timeouts+ { script = Just 5000+ , pageLoad = Just 10000+ , implicit = Just 0+ }+ setTimeouts t+ getTimeouts `shouldReturn` t++ describe "Window" do+ it "getWindowHandle returns a handle" . run' $ do+ handle <- getWindowHandle+ handle `shouldSatisfy` not . null . show++ it "getWindowHandles returns at least one handle" . run' $ do+ handles <- getWindowHandles+ handles `shouldSatisfy` not . null++ it "getWindowRect returns a rect" . run' $ do+ Rect{..} <- getWindowRect+ width `shouldSatisfy` (> 0)+ height `shouldSatisfy` (> 0)++ it "setWindowRect / getWindowRect roundtrip" . run' $ do+ let r = Rect{x = 0, y = 0, width = 800, height = 600}+ setWindowRect r+ getWindowRect `shouldReturn` r++ it "maximizeWindow does not throw" $ run' maximizeWindow+ it "minimizeWindow does not throw" $ run' minimizeWindow+ it "fullscreenWindow does not throw" $ run' fullscreenWindow++ it "newTab opens a new window handle" . run' $ do+ before <- getWindowHandles+ NewWindowResult{..} <- newTab+ -- newWindowType `shouldBe` Tab+ after <- getWindowHandles+ after `shouldBe` before <> [newWindowHandle]++ it "newWindow opens a new window handle" . run' $ do+ before <- getWindowHandles+ NewWindowResult{..} <- newTab+ -- This does not seem to work+ -- newWindowType `shouldBe` Window+ after <- getWindowHandles+ after `shouldBe` before <> [newWindowHandle]++ it "switchToWindow and closeWindow" . run' $ do+ original <- getWindowHandle+ NewWindowResult{..} <- newTab+ switchToWindow newWindowHandle+ getWindowHandle `shouldReturn` newWindowHandle+ closeWindow+ switchToWindow original+ getWindowHandle `shouldReturn` original++ describe "Element finding" do+ it "findElement by id" . run' $ do+ el <- findElement (ById "heading")+ getElementText el `shouldReturn` "Hello, Marionette!"++ it "findElement by class" . run' $ do+ el <- findElement (ByClass "content")+ getElementText el `shouldReturn` "Test paragraph"++ it "findElement by tag" . run' $ do+ el <- findElement (ByTag "h1")+ getElementText el `shouldReturn` "Hello, Marionette!"++ it "findElement by CSS selector" . run' $ do+ el <- findElement (ByCSS "#heading")+ getElementText el `shouldReturn` "Hello, Marionette!"++ it "findElement by XPath" . run' $ do+ el <- findElement (ByXPath "//h1[@id='heading']")+ getElementText el `shouldReturn` "Hello, Marionette!"++ it "findElements returns multiple elements" . run' $ do+ els <- findElements (ByClass "content")+ length els `shouldBe` 2++ it "findElementFrom finds child within parent" . run' $ do+ parent <- findElement (ById "parent")+ child <- findElementFrom parent (ById "child")+ getElementText child `shouldReturn` "Child element"++ it "findElementsFrom finds children within parent" . run' $ do+ parent <- findElement (ById "parent")+ children :: [Element] <- findElementsFrom parent (ByTag "span")+ length children `shouldBe` 1++ it "findElement by link text" . run' $ do+ navigate "http://localhost:8080/link"+ el <- findElement (ByLinkText "Click me")+ getElementText el `shouldReturn` "Click me"++ it "findElement by partial link text" . run' $ do+ navigate "http://localhost:8080/link"+ el <- findElement (ByPartialLinkText "Click here")+ text <- getElementText el+ text `shouldSatisfy` Text.isInfixOf "Click here"++ describe "Element properties" do+ it "getElementAttribute" . run' $ do+ el <- findElement (ById "para")+ getElementAttribute "class" el `shouldReturn` Just "content"++ it "getElementProperty" . run' $ do+ el <- findElement (ById "para")+ getElementProperty el "id" `shouldReturn` Just "para"++ it "getElementTagName" . run' $ do+ el <- findElement (ById "heading")+ getElementTagName el `shouldReturn` "h1"++ it "getElementRect" . run' $ do+ el <- findElement (ById "heading")+ Rect{..} <- getElementRect el+ width `shouldSatisfy` (> 0)++ it "getElementCSSValue" . run' $ do+ el <- findElement (ById "heading")+ val <- getElementCSSValue el "display"+ val `shouldSatisfy` not . null . show++ it "getComputedRole" . run' $ do+ el <- findElement (ById "heading")+ role <- getComputedRole el+ role `shouldSatisfy` not . Text.null++ it "getComputedLabel" . run' $ do+ navigate "http://localhost:8080/form"+ el <- findElement (ById "submit")+ label <- getComputedLabel el+ label `shouldSatisfy` not . Text.null++ it "isElementDisplayed" . run' $ do+ navigate "http://localhost:8080/"+ el <- findElement (ById "heading")+ isElementDisplayed el `shouldReturn` True++ it "isElementEnabled" . run' $ do+ navigate "http://localhost:8080/form"+ el <- findElement (ById "text-input")+ isElementEnabled el `shouldReturn` True++ it "isElementSelected for unchecked checkbox" . run' $ do+ navigate "http://localhost:8080/form"+ el <- findElement (ById "checkbox")+ isElementSelected el `shouldReturn` False++ it "getActiveElement does not throw" . run' . void $ getActiveElement++ describe "Element interaction" do+ it "elementClick navigates via link" . run' $ do+ navigate "http://localhost:8080/link"+ el <- findElement (ById "link")+ elementClick el+ getCurrentURL `shouldReturn` "http://localhost:8080/target"++ it "elementSendKeys fills input" . run' $ do+ navigate "http://localhost:8080/form"+ el <- findElement (ById "text-input")+ elementSendKeys el "hello"+ getElementProperty el "value" `shouldReturn` Just "hello"++ it "elementClear clears input" . run' $ do+ navigate "http://localhost:8080/form"+ el <- findElement (ById "text-input")+ elementSendKeys el "hello"+ elementClear el+ getElementProperty el "value" `shouldReturn` Just ""++ describe "Script execution" do+ it "executeScript returns a value" . run' $ do+ executeScript "return 1 + 1" [] `shouldReturn` (2 :: Int)++ it "executeScript can access elements" . run' $ do+ navigate "http://localhost:8080/"+ executeScript+ "return document.getElementById(arguments[0]).textContent"+ [toJSON @Text "heading"]+ `shouldReturn` ("Hello, Marionette!" :: Text)++ it "executeAsyncScript returns a value" . run' $ do+ executeAsyncScript @_ @_ @Int+ "const callback = arguments[arguments.length - 1]; setTimeout(() => callback(arguments[0]), 100)"+ [toJSON @Int 42]+ `shouldReturn` Just 42++ describe "Cookies" do+ it "addCookie / getCookies roundtrip" . run' $ do+ deleteAllCookies+ let cookie =+ Cookie+ { name = "test"+ , value = "value"+ , path = Just "/"+ , domain = Nothing+ , secure = Just False+ , httpOnly = Just False+ , expiry = Nothing+ }+ addCookie cookie+ cookies <- getCookies+ cookies `shouldSatisfy` any \c -> Cookie.name c == "test"++ it "deleteCookie removes a cookie" . run' $ do+ deleteAllCookies+ let cookie =+ Cookie+ { name = "todelete"+ , value = "x"+ , path = Just "/"+ , domain = Nothing+ , secure = Just False+ , httpOnly = Just False+ , expiry = Nothing+ }+ addCookie cookie+ deleteCookie "todelete"+ cookies <- getCookies+ cookies `shouldNotSatisfy` any \c -> Cookie.name c == "test"++ it "deleteAllCookies removes all cookies" . run' $ do+ deleteAllCookies+ getCookies `shouldReturn` []++ describe "Alerts" do+ it "acceptAlert dismisses an alert" . run' $ do+ navigate "http://localhost:8080/alert"+ el <- findElement (ById "alert-btn")+ elementClick el+ getAlertText `shouldReturn` "Hello!"+ acceptAlert++ it "dismissAlert dismisses a confirm dialog" . run' $ do+ navigate "http://localhost:8080/alert"+ el <- findElement (ById "confirm-btn")+ elementClick el+ dismissAlert++ it "sendAlertText fills a prompt" . run' $ do+ navigate "http://localhost:8080/alert"+ el <- findElement (ById "prompt-btn")+ elementClick el+ sendAlertText "my input"+ acceptAlert++ describe "Frames" do+ it "switchToParentFrame does not throw" . run' $ switchToParentFrame++ describe "Context" do+ it "getContext returns a context" . run' $ do+ ctx <- getContext+ ctx `shouldSatisfy` (`elem` [minBound .. maxBound])++ it "setContext / getContext roundtrip" . run' $ do+ setContext ContentContext+ getContext `shouldReturn` ContentContext+ setContext ChromeContext+ getContext `shouldReturn` ChromeContext++ describe "Shadow DOM" do+ it "getShadowRoot / findElementFromShadowRoot" . run' $ do+ navigate "http://localhost:8080/shadow"+ host <- findElement (ById "host")+ shadow <- getShadowRoot host+ el <- findElementFromShadowRoot shadow (ByCSS "#shadow-p")+ getElementText el `shouldReturn` "Shadow content"++ it "findElementsFromShadowRoot" . run' $ do+ navigate "http://localhost:8080/shadow"+ host <- findElement (ById "host")+ shadow <- getShadowRoot host+ els <- findElementsFromShadowRoot shadow (ByCSS "p")+ length els `shouldBe` 1++ describe "Screenshots" do+ it "takeScreenshot returns non-empty bytes" . run' $ do+ bytes <- takeScreenshot+ ByteString.length bytes `shouldNotBe` 0++ describe "WebAuthn" do+ it "addVirtualAuthenticator / getCredentials roundtrip" . run' $ do+ let opts =+ VirtualAuthenticator+ { protocol = "ctap2"+ , transport = "internal"+ , hasResidentKey = True+ , hasUserVerification = True+ , isUserConsenting = True+ , isUserVerified = True+ , extensions = Nothing+ , uvm = Nothing+ }+ aid <- addVirtualAuthenticator opts+ getCredentials aid `shouldReturn` []+ removeVirtualAuthenticator aid++ it "setUserVerified does not throw" . run' $ do+ let opts =+ VirtualAuthenticator+ { protocol = "ctap2"+ , transport = "internal"+ , hasResidentKey = True+ , hasUserVerification = True+ , isUserConsenting = True+ , isUserVerified = True+ , extensions = Nothing+ , uvm = Nothing+ }+ aid <- addVirtualAuthenticator opts+ setUserVerified aid False+ setUserVerified aid True+ removeVirtualAuthenticator aid++ it "removeAllCredentials does not throw" . run' $ do+ let opts =+ VirtualAuthenticator+ { protocol = "ctap2"+ , transport = "internal"+ , hasResidentKey = True+ , hasUserVerification = True+ , isUserConsenting = True+ , isUserVerified = True+ , extensions = Nothing+ , uvm = Nothing+ }+ aid <- addVirtualAuthenticator opts+ removeAllCredentials aid+ removeVirtualAuthenticator aid