{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module Test.WebDriver.Commands.Logs.BiDi (
  withRecordLogsViaBiDi
  , withRecordLogsViaBiDi'
  ) where

import Control.Monad.IO.Unlift
import Control.Monad.Logger (MonadLogger, logDebugN, logWarnN)
import Data.Aeson
import Data.Aeson.Types (parseEither)
import Data.String.Interpolate
import Data.Text (Text)
import qualified Network.URI as URI
import Test.WebDriver.Commands.BiDi.Session
import Test.WebDriver.Commands.Logs.Common
import Test.WebDriver.Types


logEvents :: [Text]
logEvents :: [Text]
logEvents = [Text
"log.entryAdded"]

-- | Wrapper around 'withRecordLogsViaBiDi'' which uses the WebSocket URL from
-- the current 'Session'. You must make sure to pass '_capabilitiesWebSocketUrl'
-- = @Just True@ to enable this. This will not work with Selenium 3.
withRecordLogsViaBiDi :: (WebDriver m, MonadLogger m) => BiDiOptions -> (LogEntry -> m ()) -> m a -> m a
withRecordLogsViaBiDi :: forall (m :: * -> *) a.
(WebDriver m, MonadLogger m) =>
BiDiOptions -> (LogEntry -> m ()) -> m a -> m a
withRecordLogsViaBiDi BiDiOptions
biDiOptions LogEntry -> m ()
cb m a
action = do
  BiDiOptions -> [Text] -> (BiDiEvent -> m ()) -> m a -> m a
forall (m :: * -> *) a.
(WebDriver m, MonadLogger m) =>
BiDiOptions -> [Text] -> (BiDiEvent -> m ()) -> m a -> m a
withBiDiSession BiDiOptions
biDiOptions [Text]
logEvents ((LogEntry -> m ()) -> BiDiEvent -> m ()
forall (m :: * -> *).
MonadLogger m =>
(LogEntry -> m ()) -> BiDiEvent -> m ()
mkLogCallback LogEntry -> m ()
cb) m a
action

-- | Connect to WebSocket URL and subscribe to log events using the W3C BiDi protocol; see
-- <https://w3c.github.io/webdriver-bidi/>.
withRecordLogsViaBiDi' :: forall m a. (MonadUnliftIO m, MonadLogger m) => BiDiOptions -> Int -> URI.URI -> (LogEntry -> m ()) -> m a -> m a
withRecordLogsViaBiDi' :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
BiDiOptions -> Int -> URI -> (LogEntry -> m ()) -> m a -> m a
withRecordLogsViaBiDi' BiDiOptions
biDiOptions Int
bidiSessionId URI
uri LogEntry -> m ()
cb m a
action =
  BiDiOptions
-> Int -> URI -> [Text] -> (BiDiEvent -> m ()) -> m a -> m a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
BiDiOptions
-> Int -> URI -> [Text] -> (BiDiEvent -> m ()) -> m a -> m a
withBiDiSession' BiDiOptions
biDiOptions Int
bidiSessionId URI
uri [Text]
logEvents ((LogEntry -> m ()) -> BiDiEvent -> m ()
forall (m :: * -> *).
MonadLogger m =>
(LogEntry -> m ()) -> BiDiEvent -> m ()
mkLogCallback LogEntry -> m ()
cb) m a
action

mkLogCallback :: (MonadLogger m) => (LogEntry -> m ()) -> BiDiEvent -> m ()
mkLogCallback :: forall (m :: * -> *).
MonadLogger m =>
(LogEntry -> m ()) -> BiDiEvent -> m ()
mkLogCallback LogEntry -> m ()
cb (BiDiEvent Text
"event" Text
"log.entryAdded" Value
params) = case Value -> Maybe LogEntry
parseBiDiLogEntry Value
params of
  Just LogEntry
logEntry -> LogEntry -> m ()
cb LogEntry
logEntry
  Maybe LogEntry
Nothing -> Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logWarnN [i|BiDi: Failed to parse log entry: #{params}|]
mkLogCallback LogEntry -> m ()
_cb BiDiEvent
x =
  Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logDebugN [i|BiDi: Ignoring non-log event message: #{x}|]

parseBiDiLogEntry :: Value -> Maybe LogEntry
parseBiDiLogEntry :: Value -> Maybe LogEntry
parseBiDiLogEntry (Object Object
o) = case (Object -> Parser LogEntry) -> Object -> Either String LogEntry
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Object -> Parser LogEntry
parseLogEntry Object
o of
  Right LogEntry
entry -> LogEntry -> Maybe LogEntry
forall a. a -> Maybe a
Just LogEntry
entry
  Left String
_ -> Maybe LogEntry
forall a. Maybe a
Nothing
  where
    parseLogEntry :: Object -> Parser LogEntry
parseLogEntry Object
o' = do
      Double
timestamp <- Object
o' Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp"
      Text
levelText <- Object
o' Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"level"
      Text
message <- Object
o' Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
      LogLevel
level <- case Text -> Maybe LogLevel
parseLogLevel Text
levelText of
        Just LogLevel
l -> LogLevel -> Parser LogLevel
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLevel
l
        Maybe LogLevel
Nothing -> String -> Parser LogLevel
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid log level"
      LogEntry -> Parser LogEntry
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LogEntry -> Parser LogEntry) -> LogEntry -> Parser LogEntry
forall a b. (a -> b) -> a -> b
$ Integer -> LogLevel -> Text -> LogEntry
LogEntry (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
timestamp :: Double)) LogLevel
level Text
message

    parseLogLevel :: Text -> Maybe LogLevel
    parseLogLevel :: Text -> Maybe LogLevel
parseLogLevel Text
"debug" = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LogDebug
    parseLogLevel Text
"info" = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LogInfo
    parseLogLevel Text
"warn" = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LogWarning
    parseLogLevel Text
"error" = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LogSevere
    parseLogLevel Text
_ = Maybe LogLevel
forall a. Maybe a
Nothing
parseBiDiLogEntry Value
_ = Maybe LogEntry
forall a. Maybe a
Nothing