From d647a0fac39408d9f45a4bbb2a9f1c095ab4cfb4 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Wed, 23 Jun 2021 18:33:11 +1200
Subject: [PATCH] Add noop stubs to control non-existant windows.

---
 src/Webdriver.hs | 33 ++++++++++++++++++++++++++++++++-
 1 file changed, 32 insertions(+), 1 deletion(-)

diff --git a/src/Webdriver.hs b/src/Webdriver.hs
index 5bc0df1..01e76dc 100644
--- a/src/Webdriver.hs
+++ b/src/Webdriver.hs
@@ -40,7 +40,13 @@ serveSession sessions = WD.withSession fail (\uuid session -> msum [
         dir "url" $ getURL session,
         dir "refresh" $ reloadPage session,
         dir "back" $ sessionAction WD.back session,
-        dir "forward" $ sessionAction WD.next session
+        dir "forward" $ sessionAction WD.next session,
+        dir "window" $ msum [ -- Noops
+            getWindowHandle uuid,
+            delSession sessions uuid, -- Closing the only window closes the session.
+            switchWindowHandle uuid,
+            dir "handles" $ getWindowHandles uuid
+        ]
     ]) sessions
   where
     fail uuid'| Just _ <- ID.fromString uuid' = errJSON 404 "invalid session ID" $ (
@@ -118,3 +124,28 @@ sessionAction cb session = do
     nullDir
     liftIO $ cb session
     ok $ toResponse ()
+
+---- Windowing noops
+getWindowHandle uuid = do
+    method GET
+    nullDir
+    ok $ toResponse ("window-" ++ ID.toString uuid)
+
+data WindowHandle = WindowHandle { handle :: String } deriving Generic
+instance FromJSON WindowHandle
+switchWindowHandle uuid = do
+    method POST
+    nullDir
+    handle <- getJSON
+    case handle of
+        Nothing -> errJSON 400 "invalid argument" "Failed to parse JSON input"
+        Just (WindowHandle handle') | handle' /= "window-" ++ ID.toString uuid ->
+            errJSON 404 "no such window" "Rhapsode isn't a multi-window or multi-tab browser"
+        _ -> ok $ toResponse ()
+
+getWindowHandles uuid = do
+    method GET
+    nullDir
+    okJSON ["window-" ++ ID.toString uuid]
+
+
-- 
2.30.2