From 23e975191744b5c1f6692fd9322d385a1cdd9855 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Sun, 27 Jun 2021 09:18:44 +1200
Subject: [PATCH] Add session/*/element WebDriver endpoint.

---
 src/Webdriver.hs | 21 ++++++++++++++++++---
 1 file changed, 18 insertions(+), 3 deletions(-)

diff --git a/src/Webdriver.hs b/src/Webdriver.hs
index 2a9a458..654a42e 100644
--- a/src/Webdriver.hs
+++ b/src/Webdriver.hs
@@ -4,7 +4,7 @@ module Webdriver(serveWebdriver) where
 import Happstack.Lite
 import Control.Concurrent.MVar
 import Data.Aeson
-import Data.Text (Text)
+import Data.Text (Text, unpack)
 import GHC.Generics
 import Data.ByteString.Lazy (ByteString)
 
@@ -56,7 +56,8 @@ serveSession sessions = WD.withSession fail (\uuid session -> msum [
             dir "fullscreen" $ unsupportedOp
         ],
         dir "frame" $ msum [noSuchFrame, dir "parent" $ ok $ toResponse ()], -- Noops
-        dir "elements" $ findFromRoot session
+        dir "element" $ findFromRoot session,
+        dir "elements" $ findAllFromRoot session
     ]) sessions
   where
     fail uuid'| Just _ <- ID.fromString uuid' = errJSON 404 "invalid session ID" $ (
@@ -175,7 +176,7 @@ unsupportedOp = do
 
 ----
 
-findFromRoot session = do
+findAllFromRoot session = do
     method POST
     nullDir
     req <- getJSON
@@ -186,3 +187,17 @@ findFromRoot session = do
             Left (True, msg) -> errJSON 400 "invalid selector" msg
             Left (False, msg) -> errJSON 400 "invalid argument" msg
         Nothing -> errJSON 400 "invalid argument" "Failed to parse JSON"
+
+findFromRoot session = do
+    method POST
+    nullDir
+    req <- getJSON
+    session' <- liftIO $ readMVar session
+    case req of
+        Just req' -> case WDE.find req' $ XC.fromDocument $ WD.document session' of
+            Right (res:_) -> okJSON =<< liftIO (WD.serializeEl session res)
+            Right [] | WDE.Find using query <- req' -> errJSON 404 "No such element" (
+                "No elements match " ++ unpack using ++ " query: " ++ query)
+            Left (True, msg) -> errJSON 400 "invalid selector" msg
+            Left (False, msg) -> errJSON 400 "invalid argument" msg
+        Nothing -> errJSON 400 "invalid argument" "Failed to parse JSON"
-- 
2.30.2