InputEventDemos.hs

module BiDi.Demos.InputEventDemos where

import BiDi.Actions (BiDiActions (..))
import BiDi.DemoUtils
import Data.Maybe (fromJust)
import IOUtils (DemoActions (..))
import TestData (uploadUrl)
import WebDriverPreCore.BiDi.Protocol
import Prelude hiding (log, putStrLn)

-- Helper function to create default pointer common properties
defaultPointerProps :: PointerCommonProperties
defaultPointerProps =
  MkPointerCommonProperties
    { width = Nothing,
      height = Nothing,
      pressure = Nothing,
      tangentialPressure = Nothing,
      twist = Nothing,
      altitudeAngle = Nothing,
      azimuthAngle = Nothing
    }

{- 
Input Events - Implementation Status:

1. input.fileDialogOpened :: ✓ inputEventFileDialogOpened (parsing works)
   Firefox/geckodriver closes WebSocket connection when file dialog opens in headless mode,
   causing ConnectionClosed exception. Events are received and parsed correctly before disconnect.
   See bugs: 1855044, 1855045

The demos below work for event parsing but Firefox crashes in headless mode when file dialog opens.
-}



-- >>> runDemo inputEventFileDialogOpened
inputEventFileDialogOpened :: BiDiDemo
inputEventFileDialogOpened =
  demo "Input Events - File Dialog Opened (Single File)" action
  where
    action :: DemoActions -> BiDiActions -> IO ()
    action utils@MkDemoActions {..} bidi@MkBiDiActions {..} = do
      logTxt "Subscribe to FileDialogOpened event"
      (fileDialogEventFired, waitFileDialogEventFired) <- timeLimitLog InputFileDialogOpened
      subscribeInputFileDialogOpened fileDialogEventFired

      (manyFileDialogEventFired, waitManyFileDialogEventFired) <- timeLimitLogMany InputFileDialogOpened
      subscribeMany [InputFileDialogOpened] manyFileDialogEventFired

      bc <- newWindowContext utils bidi
      logTxt "Navigating to upload page"
      url <- uploadUrl
      browsingContextNavigate $ MkNavigate bc url Nothing

      logTxt "Locating single file upload input"
      uploadInput <-
        browsingContextLocateNodes $
          MkLocateNodes
            { context = bc,
              locator = CSS {value = "#singleUpload"},
              maxNodeCount = Nothing,
              serializationOptions = Nothing,
              startNodes = Nothing
            }
      logShow "Upload input element" uploadInput

      let MkLocateNodesResult nodes = uploadInput
          uploadInputId :: SharedId
          uploadInputId = case nodes of
            [input] -> fromJust input.sharedId
            _ -> error "Failed to locate single file upload input"

      logTxt "Clicking on file upload input to open file dialog"
      inputPerformActions $
        MkPerformActions
          { context = bc,
            actions =
              [ PointerSourceActions $
                  MkPointerSourceActions
                    { pointerId = "mouse1",
                      pointer = Just $ MkPointer {pointerType = Just MousePointer},
                      pointerActions =
                        [ PointerMove
                            { x = 0,
                              y = 0,
                              duration = Nothing,
                              origin =
                                Just $
                                  ElementOrigin $
                                    MkSharedReference
                                      { sharedId = uploadInputId,
                                        handle = Nothing,
                                        extensions = Nothing
                                      },
                              pointerCommonProperties = defaultPointerProps
                            },
                          PointerDown
                            { button = 0,
                              pointerCommonProperties = defaultPointerProps
                            },
                          PointerUp
                            { button = 0
                            }
                        ]
                    }
              ]
          }

      logTxt "Waiting for file dialog opened events..."
      sequence_
        [ waitFileDialogEventFired,
          waitManyFileDialogEventFired
        ]