module BiDi.Demos.LogEventDemos where import BiDi.Actions (BiDiActions (..)) import BiDi.DemoUtils ( demo, rootContext, BiDiDemo ) import Data.Maybe (fromJust) import IOUtils (DemoActions (..)) import TestData (badJavaScriptUrl, consoleLogUrl) import WebDriverPreCore.BiDi.Protocol ( ContextTarget (..), Evaluate (..), Event(..), LocateNodes (..), LocateNodesResult (..), Locator (..), LogEntry (..), LogEvent(..), Navigate (..), NodeRemoteValue (..), PointerCommonProperties (..), PointerSourceActions (..), PointerSourceAction (..), KnownSubscriptionType (..), Pointer (..), PointerType (..), Origin (..), PerformActions (..), SourceActions (..), SharedId, SharedReference (..), Target (..) ) import Prelude hiding (log, putStrLn) import Data.Text (Text) import Control.Monad ((>=>)) import Data.Coerce (coerce) -- >>> runDemo logEventConsoleEntries logEventConsoleEntries :: BiDiDemo logEventConsoleEntries = demo "Log Events - Console Log Entries" action where action :: DemoActions -> BiDiActions -> IO () action utils@MkDemoActions {..} bidi@MkBiDiActions {..} = do logTxt "Subscribe to LogEntryAdded event" (logEventFired, waitLogEventFired) <- timeLimitLog LogEntryAdded subscribeLogEntryAdded $ chkIsConsoleEntry logTxt >=> logEventFired (manyLogEventFired, waitManyLogEventFired) <- timeLimitLogMany LogEntryAdded subscribeMany [LogEntryAdded] $ chkEventIsConsoleEntry logTxt >=> manyLogEventFired logTxt "Navigate to console log test page" url <- consoleLogUrl bc <- rootContext utils bidi browsingContextNavigate $ MkNavigate bc url Nothing -- Page automatically logs on load, so events should fire logTxt "Waiting for console log events from page load..." sequence_ [ waitLogEventFired, waitManyLogEventFired ] -- >>> runDemo logEventConsoleLevelDebug logEventConsoleLevelDebug :: BiDiDemo logEventConsoleLevelDebug = demo "Log Events - Console Debug Level" action where action :: DemoActions -> BiDiActions -> IO () action utils@MkDemoActions {..} bidi@MkBiDiActions {..} = do bc <- rootContext utils bidi logTxt "Subscribe to LogEntryAdded event" (logEventFired, waitLogEventFired) <- timeLimitLog LogEntryAdded subscribeLogEntryAdded $ chkIsConsoleEntry logTxt >=> logEventFired (manyLogEventFired, waitManyLogEventFired) <- timeLimitLogMany LogEntryAdded subscribeMany [LogEntryAdded] $ chkEventIsConsoleEntry logTxt >=> manyLogEventFired logTxt "Triggering console.debug()" scriptEvaluate $ MkEvaluate { expression = "console.debug('Debug level message')", target = ContextTarget $ MkContextTarget {context = bc, sandbox = Nothing}, awaitPromise = False, resultOwnership = Nothing, serializationOptions = Nothing } sequence_ [ waitLogEventFired, waitManyLogEventFired ] -- >>> runDemo logEventConsoleLevelInfo logEventConsoleLevelInfo :: BiDiDemo logEventConsoleLevelInfo = demo "Log Events - Console Info Level" action where action :: DemoActions -> BiDiActions -> IO () action utils@MkDemoActions {..} bidi@MkBiDiActions {..} = do bc <- rootContext utils bidi logTxt "Subscribe to LogEntryAdded event" (logEventFired, waitLogEventFired) <- timeLimitLog LogEntryAdded subscribeLogEntryAdded $ chkIsConsoleEntry logTxt >=> logEventFired (manyLogEventFired, waitManyLogEventFired) <- timeLimitLogMany LogEntryAdded subscribeMany [LogEntryAdded] $ chkEventIsConsoleEntry logTxt >=> manyLogEventFired logTxt "Triggering console.info()" scriptEvaluate $ MkEvaluate { expression = "console.info('Info level message')", target = ContextTarget $ MkContextTarget {context = bc, sandbox = Nothing}, awaitPromise = False, resultOwnership = Nothing, serializationOptions = Nothing } sequence_ [ waitLogEventFired, waitManyLogEventFired ] -- >>> runDemo logEventConsoleLevelWarn logEventConsoleLevelWarn :: BiDiDemo logEventConsoleLevelWarn = demo "Log Events - Console Warn Level" action where action :: DemoActions -> BiDiActions -> IO () action utils@MkDemoActions {..} bidi@MkBiDiActions {..} = do bc <- rootContext utils bidi logTxt "Subscribe to LogEntryAdded event" (logEventFired, waitLogEventFired) <- timeLimitLog LogEntryAdded subscribeLogEntryAdded $ chkIsConsoleEntry logTxt >=> logEventFired (manyLogEventFired, waitManyLogEventFired) <- timeLimitLogMany LogEntryAdded subscribeMany [LogEntryAdded] $ chkEventIsConsoleEntry logTxt >=> manyLogEventFired logTxt "Triggering console.warn()" scriptEvaluate $ MkEvaluate { expression = "console.warn('Warning level message')", target = ContextTarget $ MkContextTarget {context = bc, sandbox = Nothing}, awaitPromise = False, resultOwnership = Nothing, serializationOptions = Nothing } sequence_ [ waitLogEventFired, waitManyLogEventFired ] -- >>> runDemo logEventConsoleLevelError logEventConsoleLevelError :: BiDiDemo logEventConsoleLevelError = demo "Log Events - Console Error Level" action where action :: DemoActions -> BiDiActions -> IO () action utils@MkDemoActions {..} bidi@MkBiDiActions {..} = do bc <- rootContext utils bidi logTxt "Subscribe to LogEntryAdded event" (logEventFired, waitLogEventFired) <- timeLimitLog LogEntryAdded subscribeLogEntryAdded $ chkIsConsoleEntry logTxt >=> logEventFired (manyLogEventFired, waitManyLogEventFired) <- timeLimitLogMany LogEntryAdded subscribeMany [LogEntryAdded] $ chkEventIsConsoleEntry logTxt >=> manyLogEventFired logTxt "Triggering console.error()" scriptEvaluate $ MkEvaluate { expression = "console.error('Error level message')", target = ContextTarget $ MkContextTarget {context = bc, sandbox = Nothing}, awaitPromise = False, resultOwnership = Nothing, serializationOptions = Nothing } sequence_ [ waitLogEventFired, waitManyLogEventFired ] -- >>> runDemo logEventJavascriptErrorFromButton logEventJavascriptErrorFromButton :: BiDiDemo logEventJavascriptErrorFromButton = demo "Log Events - JavaScript Error from Button Click" action where action :: DemoActions -> BiDiActions -> IO () action utils@MkDemoActions {..} bidi@MkBiDiActions {..} = do logTxt "Navigate to Bad JavaScript test page" url <- badJavaScriptUrl bc <- rootContext utils bidi browsingContextNavigate $ MkNavigate bc url Nothing pause logTxt "Subscribe to LogEntryAdded event" (logEventFired, waitLogEventFired) <- timeLimitLog LogEntryAdded subscribeLogEntryAdded $ chkIsJavaScriptEntry logTxt >=> logEventFired (manyLogEventFired, waitManyLogEventFired) <- timeLimitLogMany LogEntryAdded subscribeMany [LogEntryAdded] $ chkEventIsJavaScriptEntry logTxt >=> manyLogEventFired logTxt "Locate the 'Bad JS' button" buttonResult <- browsingContextLocateNodes $ MkLocateNodes { context = bc, locator = CSS {value = "#badJsButton"}, maxNodeCount = Nothing, serializationOptions = Nothing, startNodes = Nothing } logShow "Button search result" buttonResult let MkLocateNodesResult nodes = buttonResult buttonId :: SharedId buttonId = case nodes of [button] -> fromJust button.sharedId _ -> error "Failed to locate Bad JS button" logTxt "Click the 'Bad JS' button to trigger JavaScript error" inputPerformActions $ MkPerformActions { context = bc, actions = [ PointerSourceActions $ MkPointerSourceActions { pointerId = "mouse1", pointer = Just $ MkPointer {pointerType = Just MousePointer}, pointerActions = [ PointerMove { x = 0, y = 0, duration = Just 300, origin = Just $ ElementOrigin $ MkSharedReference { sharedId = buttonId, handle = Nothing, extensions = Nothing }, pointerCommonProperties = defaultPointerProps }, PointerDown { button = 0, pointerCommonProperties = defaultPointerProps }, PointerUp { button = 0 } ] } ] } logTxt "Waiting for JavaScript error log events..." sequence_ [ waitLogEventFired, waitManyLogEventFired ] {- Doesn't work - can't work out how to generate a generic log entry -- >>> runDemo logEventGenericEntry logEventGenericEntry :: BiDiDemo logEventGenericEntry = demo "Log Events - Generic Log Entry" action where -- Generic log entries are less common and typically generated by browser internals -- or specific browser features. This demo shows how to subscribe to all log events -- and observe generic entries if they occur. action :: DemoUtils -> BiDiActions -> IO () action utils@MkDemoActions {..} bidi@MkBiDiActions {..} = do logTxt "Subscribe to LogEntryAdded event (all types)" (logEventFired, waitLogEventFired) <- timeLimitLog LogEntryAdded subscribeLogEntryAdded logEventFired (manyLogEventFired, waitManyLogEventFired) <- timeLimitLogMany LogEntryAdded subscribeMany [LogEntryAdded] manyLogEventFired logTxt "Navigate to checkboxes page" url <- checkboxesUrl bc <- rootContext utils bidi browsingContextNavigate $ MkNavigate bc url Nothing pause logTxt "Generate various log entries" scriptEvaluate $ MkEvaluate { expression = "console.log('This generates a console log entry')", target = ContextTarget $ MkContextTarget {context = bc, sandbox = Nothing}, awaitPromise = False, resultOwnership = Nothing, serializationOptions = Nothing } sequence_ [ waitLogEventFired, waitManyLogEventFired ] logTxt "Note: Generic log entries are browser-generated and may not occur in this demo" logTxt "The subscription will capture console and javascript entries as demonstrated" -} -- Helpers defaultPointerProps :: PointerCommonProperties defaultPointerProps = MkPointerCommonProperties { width = Nothing, height = Nothing, pressure = Nothing, tangentialPressure = Nothing, twist = Nothing, altitudeAngle = Nothing, azimuthAngle = Nothing } chkIsConsoleEntry :: (Text -> IO ()) -> LogEntry -> IO LogEntry chkIsConsoleEntry log = \case entry@ConsoleEntry {} -> log "Received Console Log Entry" >> pure entry entry -> fail $ "Expected Console Log Entry But Got: " <> show entry chkIsJavaScriptEntry :: (Text -> IO ()) -> LogEntry -> IO LogEntry chkIsJavaScriptEntry log = \case entry@JavascriptEntry {} -> log "Received JavaScript Log Entry" >> pure entry entry -> fail $ "Expected JavaScript Log Entry But Got: " <> show entry chkEventIsConsoleEntry :: (Text -> IO ()) -> Event -> IO LogEntry chkEventIsConsoleEntry log = \case LogEvent event -> log "Received Log Event" >> chkIsConsoleEntry log (coerce event) event -> fail $ "Expected Console Event But Got: " <> show event chkEventIsJavaScriptEntry :: (Text -> IO ()) -> Event -> IO LogEntry chkEventIsJavaScriptEntry log = \case LogEvent event -> log "Received Log Event" >> chkIsJavaScriptEntry log (coerce event) event -> fail $ "Expected JavaScript Event But Got: " <> show event