module BiDi.Demos.SessionDemos where import BiDi.Actions (BiDiActions (..)) import BiDi.DemoUtils import IOUtils (DemoActions (..)) import WebDriverPreCore.BiDi.Protocol ( Capabilities (..), Capability (..), CreateUserContext (..), KnownSubscriptionType (..), ProxyConfiguration (..), SessionNewResult (..), SessionStatusResult (..), SessionSubscibe (..), SessionUnsubscribe (..), SubscriptionType (..), UserPromptHandler (..), UserPromptHandlerType (..), ) import Prelude hiding (log, putStrLn) -- TODO: change from text to typed events -- >>> runDemo sessionStatusDemo sessionStatusDemo :: BiDiDemo sessionStatusDemo = demo "Session - Status Check" action where action :: DemoActions -> BiDiActions -> IO () action MkDemoActions {..} MkBiDiActions {..} = do logTxt "Checking session status" status <- sessionStatus logShow "Session status" status pause logTxt "Interpreting status result" case status of MkSessionStatusResult True msg -> logTxt $ "✓ Session is ready: " <> msg MkSessionStatusResult False msg -> logTxt $ "✗ Session not ready: " <> msg pause -- >>> runDemo sessionNewDemo -- *** Exception: Error executing BiDi command: MkCommand -- { method = "session.new" -- , params = -- MkCapabilities { alwaysMatch = Nothing , firstMatch = [] } -- , extended = Nothing -- } -- With JSON: -- { -- "id": 1, -- "method": "session.new", -- "params": { -- "capabilities": {}, -- "firstMatch": [] -- } -- } -- BiDi driver error: -- MkDriverError -- { id = Just 1 -- , error = SessionNotCreated -- , description = "Failed to create a new session" -- , message = "Maximum number of active sessions" -- , stacktrace = -- Just -- "RemoteError@chrome://remote/content/shared/RemoteError.sys.mjs:8:8\nWebDriverError@chrome://remote/content/shared/webdriver/Errors.sys.mjs:202:5\nSessionNotCreatedError@chrome://remote/content/shared/webdriver/Errors.sys.mjs:814:5\ncreateSession@chrome://remote/content/webdriver-bidi/WebDriverBiDi.sys.mjs:127:13\nonPacket@chrome://remote/content/webdriver-bidi/WebDriverBiDiConnection.sys.mjs:206:55\nonMessage@chrome://remote/content/server/WebSocketTransport.sys.mjs:127:18\nhandleEvent@chrome://remote/content/server/WebSocketTransport.sys.mjs:109:14\n" -- , extensions = MkEmptyResult { extensible = fromList [] } -- } sessionNewDemo :: BiDiDemo sessionNewDemo = demo "Session - New Session Creation" action where action :: DemoActions -> BiDiActions -> IO () action MkDemoActions {..} MkBiDiActions {..} = do logTxt "Creating new BiDi session with basic capabilities" let basicCapabilities = MkCapabilities { alwaysMatch = Nothing, firstMatch = [] } newSession <- sessionNew basicCapabilities logShow "New session created" newSession pause logTxt "Session information:" logTxt $ "Session ID: " <> newSession.sessionId logShow "Capabilities result" newSession.capabilities pause -- TODO: Add orchestration between receive loop and session.end to suppress ConnectionClosed when connection closes gracefully -- >>> runDemo sessionEndDemo sessionEndDemo :: BiDiDemo sessionEndDemo = demo "Session - End Session" action where action :: DemoActions -> BiDiActions -> IO () action MkDemoActions {..} MkBiDiActions {..} = do logTxt "⚠️ WARNING: This will end the current session!" logTxt "Ending current session gracefully" result <- sessionEnd logShow "Session end result" result pause -- >>> runDemo sessionSubscribeDemo sessionSubscribeDemo :: BiDiDemo sessionSubscribeDemo = demo "Session - Event Subscription" action where action :: DemoActions -> BiDiActions -> IO () action utils@MkDemoActions {..} bidi@MkBiDiActions {..} = do bc <- rootContext utils bidi logTxt "Test 1: Subscribe to browsing context events globally" let globalSubscription = MkSessionSubscribe { events = KnownSubscriptionType <$> [BrowsingContextContextCreated, BrowsingContextContextDestroyed], contexts = Nothing, userContexts = Nothing } sub1 <- sessionSubscribe globalSubscription logShow "Global subscription" sub1 pause logTxt "Test 2: Subscribe to network events for specific context" let contextSubscription = MkSessionSubscribe { events = KnownSubscriptionType <$> [NetworkFetchError, NetworkResponseCompleted], contexts = Just [bc], userContexts = Nothing } sub2 <- sessionSubscribe contextSubscription logShow "Context-specific subscription" sub2 pause logTxt "Test 3: Subscribe to script events for user context" -- Get current user contexts or create a new one if needed userContextsResult <- browserGetUserContexts logShow "Current user contexts" userContextsResult -- Create a new user context for demonstration currentUserContext <- browserCreateUserContext MkCreateUserContext { insecureCerts = Nothing, proxy = Nothing, unhandledPromptBehavior = Nothing } logShow "Created user context" currentUserContext let userContextSubscription = MkSessionSubscribe { events = [KnownSubscriptionType ScriptRealmCreated], contexts = Nothing, userContexts = Just [currentUserContext] } sub3 <- sessionSubscribe userContextSubscription logShow "User context subscription" sub3 pause -- >>> runDemo sessionUnsubscribeDemo sessionUnsubscribeDemo :: BiDiDemo sessionUnsubscribeDemo = demo "Session - Event Unsubscription" action where action :: DemoActions -> BiDiActions -> IO () action MkDemoActions {..} MkBiDiActions {..} = do logTxt "First, create a subscription to demonstrate unsubscription" let subscription = MkSessionSubscribe { events = [KnownSubscriptionType BrowsingContextContextCreated], contexts = Nothing, userContexts = Nothing } subResult <- sessionSubscribe subscription logShow "Created subscription" subResult pause logTxt "Test 1: Unsubscribe by subscription ID" let unsubByID = UnsubscribeById { subscriptions = [subResult] } result1 <- sessionUnsubscribe unsubByID logShow "Unsubscribed by ID" result1 pause logTxt "Now, Subscribe to network events for specific context" let contextSubscription = MkSessionSubscribe { events = [KnownSubscriptionType NetworkResponseCompleted], contexts = Nothing, userContexts = Nothing } sub2 <- sessionSubscribe contextSubscription logShow "Context-specific subscription" sub2 pause logTxt "Test 2: Unsubscribe by attributes (alternative method)" let unsubByAttrs = UnsubscribeByAttributes { unsubEvents = [KnownSubscriptionType NetworkResponseCompleted] } result2 <- sessionUnsubscribe unsubByAttrs logShow "Unsubscribed by attributes" result2 pause -- >>> runDemo sessionCapabilityNegotiationDemo -- *** Exception: Error executing BiDi command: MkCommand -- { method = "session.new" -- , params = -- MkCapabilities -- { alwaysMatch = -- Just -- MkCapability -- { acceptInsecureCerts = Just True -- , browserName = Just "firefox" -- , browserVersion = Nothing -- , webSocketUrl = True -- , platformName = Just "linux" -- , proxy = Nothing -- , unhandledPromptBehavior = Nothing -- } -- , firstMatch = [] -- } -- , extended = Nothing -- } -- With JSON: -- { -- "id": 1, -- "method": "session.new", -- "params": { -- "capabilities": { -- "alwaysMatch": { -- "acceptInsecureCerts": true, -- "browserName": "firefox", -- "browserVersion": null, -- "platformName": "linux", -- "proxy": null, -- "unhandledPromptBehavior": null, -- "webSocketUrl": true -- } -- }, -- "firstMatch": [] -- } -- } -- Failed to decode the 'result' property of JSON returned by driver to response type: -- { -- "error": "session not created", -- "id": 1, -- "message": "Maximum number of active sessions", -- "stacktrace": "RemoteError@chrome://remote/content/shared/RemoteError.sys.mjs:8:8\nWebDriverError@chrome://remote/content/shared/webdriver/Errors.sys.mjs:202:5\nSessionNotCreatedError@chrome://remote/content/shared/webdriver/Errors.sys.mjs:814:5\ncreateSession@chrome://remote/content/webdriver-bidi/WebDriverBiDi.sys.mjs:127:13\nonPacket@chrome://remote/content/webdriver-bidi/WebDriverBiDiConnection.sys.mjs:206:55\nonMessage@chrome://remote/content/server/WebSocketTransport.sys.mjs:127:18\nhandleEvent@chrome://remote/content/server/WebSocketTransport.sys.mjs:109:14\n", -- "type": "error" -- } -- Error message: -- key "result" not found sessionCapabilityNegotiationDemo :: BiDiDemo sessionCapabilityNegotiationDemo = demo "Session - Capability Negotiation" action where action :: DemoActions -> BiDiActions -> IO () action MkDemoActions {..} MkBiDiActions {..} = do logTxt "Test 1: Session with alwaysMatch capabilities" let alwaysMatchCap = MkCapability { acceptInsecureCerts = Just True, browserName = Just "firefox", browserVersion = Nothing, webSocketUrl = True, platformName = Just "linux", proxy = Nothing, unhandledPromptBehavior = Nothing } let alwaysMatchCapabilities = MkCapabilities { alwaysMatch = Just alwaysMatchCap, firstMatch = [] } session1 <- sessionNew alwaysMatchCapabilities logShow "Session with alwaysMatch" session1 pause logTxt "Test 2: Session with firstMatch capabilities" let firstMatchCap1 = MkCapability { acceptInsecureCerts = Just False, browserName = Just "firefox", browserVersion = Just "130.0", webSocketUrl = True, platformName = Just "linux", proxy = Just DirectProxyConfiguration, unhandledPromptBehavior = Nothing } let firstMatchCap2 = MkCapability { acceptInsecureCerts = Just True, browserName = Nothing, browserVersion = Nothing, webSocketUrl = True, platformName = Nothing, proxy = Nothing, unhandledPromptBehavior = Just $ MkUserPromptHandler { alert = Just Accept, beforeUnload = Just Dismiss, confirm = Just Accept, defaultHandler = Just Ignore, fileHandler = Nothing, prompt = Just Accept } } let firstMatchCapabilities = MkCapabilities { alwaysMatch = Nothing, firstMatch = [firstMatchCap1, firstMatchCap2] } session2 <- sessionNew firstMatchCapabilities logShow "Session with firstMatch" session2 pause -- >>> runDemo sessionCompleteLifecycleDemo sessionCompleteLifecycleDemo :: BiDiDemo sessionCompleteLifecycleDemo = demo "Session - Complete Lifecycle Management" action where action :: DemoActions -> BiDiActions -> IO () action MkDemoActions {..} MkBiDiActions {..} = do logTxt "Step 1: Check initial session status" initialStatus <- sessionStatus logShow "Initial status" initialStatus pause logTxt "Step 2: Subscribe to key events" let subscription = MkSessionSubscribe { events = KnownSubscriptionType <$> [BrowsingContextContextCreated, BrowsingContextNavigationStarted], contexts = Nothing, userContexts = Nothing } subResult <- sessionSubscribe subscription logShow "Event subscription" subResult pause logTxt "Step 3: Perform some operations (context creation)" -- This would normally create contexts and generate events logTxt "Events would be generated during normal operations..." pause logTxt "Step 4: Check status after operations" operationStatus <- sessionStatus logShow "Status after operations" operationStatus pause logTxt "Step 5: Clean up subscriptions" let cleanup = UnsubscribeById { subscriptions = [subResult] } cleanupResult <- sessionUnsubscribe cleanup logShow "Cleanup result" cleanupResult pause logTxt "Session lifecycle demo complete"