NetworkSupportTest.hs

module BiDi.Demos.NetworkSupportTest where

import BiDi.Actions (BiDiActions (..))
import BiDi.DemoUtils
import Control.Exception (SomeException, throwIO, try)
import IOUtils (DemoActions (..), exceptionTextIncludes)
import WebDriverPreCore.BiDi.Protocol
  ( AddDataCollector (..),
    AddIntercept (..),
    CacheBehavior (..),
    ContinueRequest (..),
    DataType (..),
    InterceptPhase (..),
    JSUInt (..),
    Request (..),
    SetCacheBehavior (..)
  )
import Prelude hiding (log)

-- Test which network commands are actually supported by the current driver

-- >>> runDemo networkSupportTest
networkSupportTest :: BiDiDemo
networkSupportTest =
  demo "Network Support Test - Check which commands are implemented" action
  where
    action :: DemoActions -> BiDiActions -> IO ()
    action utils@MkDemoActions {..} bidi@MkBiDiActions {..} = do
      bc <- rootContext utils bidi

      logTxt "Testing network command support in current WebDriver implementation..."
      logTxt "Commands that fail with 'unknown command' are not yet implemented."
      pause

      -- Test 1: addDataCollector
      logTxt "Test 1: network.addDataCollector"
      result1 <-
        try $
          networkAddDataCollector $
            MkAddDataCollector
              { dataTypes = [Response],
                maxEncodedDataSize = MkJSUInt 1024,
                collectorType = Nothing,
                contexts = Nothing,
                userContexts = Nothing
              }
      handleCommandResult result1
      pause

      -- Test 2: addIntercept
      logTxt "Test 2: network.addIntercept"
      result2 <-
        try $
          networkAddIntercept $
            MkAddIntercept
              { phases = [BeforeRequestSent],
                contexts = Just [bc],
                urlPatterns = Nothing
              }
      handleCommandResult result2
      pause

      -- Test 3: setCacheBehavior
      logTxt "Test 3: network.setCacheBehavior"
      result3 <-
        try $
          networkSetCacheBehavior $
            MkSetCacheBehavior
              { cacheBehavior = DefaultCacheBehavior,
                contexts = Nothing
              }
      handleCommandResult result3
      pause

      -- Test 4: continueRequest (requires active intercept, so will fail with "no such request")
      logTxt "Test 4: network.continueRequest"
      result4 <-
        try $
          networkContinueRequest $
            MkContinueRequest
              { request = MkRequest "test-request-id",
                body = Nothing,
                cookies = Nothing,
                headers = Nothing,
                method = Nothing,
                url = Nothing
              }
      handleCommandResult result4
      pause

      logTxt "Support test completed."
      logTxt "❌ = Command not implemented in driver"
      logTxt "✅ = Command supported and works (or exists but needs active request)"
      logTxt "⚠️ = Command supported but failed for unexpected reason"
      where
        handleCommandResult :: Either SomeException a -> IO ()
        handleCommandResult = either handleError (const $ logTxt "✅ SUPPORTED")
          where
            handleError (e :: SomeException) =
              let errIncludes = any (flip exceptionTextIncludes e)
               in if
                    | errIncludes ["unknown command", "not supported"] ->
                        logShow "❌ NOT SUPPORTED (unknown command)" e
                    | errIncludes ["no such request", "not found"] ->
                        logTxt "✅ SUPPORTED (command exists but no active request - expected)"
                    | otherwise ->
                        do
                          logShow "⚠️ SUPPORTED but failed" e
                          throwIO e