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

module Test.WebDriver.Commands.Logs.Chrome (
  getChromeLogs
  ) where

import Data.Aeson
import qualified Data.Foldable as F
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Stack
import Test.WebDriver.Commands.Logs.Common
import Test.WebDriver.JSON
import Test.WebDriver.Types
import Test.WebDriver.Util.Aeson
import Test.WebDriver.Util.Commands
import UnliftIO.Exception


getChromeLogs :: (HasCallStack, WebDriver wd) => LogType -> wd [LogEntry]
getChromeLogs :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
LogType -> wd [LogEntry]
getChromeLogs LogType
logType =
  wd [LogEntry] -> wd (Either SomeException [LogEntry])
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (LogType -> wd [LogEntry]
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
LogType -> wd [LogEntry]
getChromeLogsViaCDP LogType
logType) wd (Either SomeException [LogEntry])
-> (Either SomeException [LogEntry] -> wd [LogEntry])
-> wd [LogEntry]
forall a b. wd a -> (a -> wd b) -> wd b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right [LogEntry]
entries -> [LogEntry] -> wd [LogEntry]
forall a. a -> wd a
forall (m :: * -> *) a. Monad m => a -> m a
return [LogEntry]
entries
    Left (SomeException
_ :: SomeException) -> LogType -> wd [LogEntry]
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
LogType -> wd [LogEntry]
getLegacyChromeLogs LogType
logType

getChromeLogsViaCDP :: (HasCallStack, WebDriver wd) => LogType -> wd [LogEntry]
getChromeLogsViaCDP :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
LogType -> wd [LogEntry]
getChromeLogsViaCDP LogType
_logType = do
  Value
result <- Method -> Text -> Value -> wd Value
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/goog/cdp/execute" (Value -> wd Value) -> Value -> wd Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [
    Key
"cmd" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"Runtime.getConsoleEntries" :: Text)
    , Key
"params" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object []
    ]
  case Value
result of
    (Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"value" -> Just (Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"result" -> Just (Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"entries" -> Just (Array Array
entries))))))) ->
      (Value -> wd LogEntry) -> [Value] -> wd [LogEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> wd LogEntry
forall (wd :: * -> *). WebDriver wd => Value -> wd LogEntry
parseChromeLogEntry (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Array
entries)
    Value
_ -> [LogEntry] -> wd [LogEntry]
forall a. a -> wd a
forall (m :: * -> *) a. Monad m => a -> m a
return []

  where
    parseChromeLogEntry :: (WebDriver wd) => Value -> wd LogEntry
    parseChromeLogEntry :: forall (wd :: * -> *). WebDriver wd => Value -> wd LogEntry
parseChromeLogEntry (Object Object
obj) = do
      Double
timestamp :: Double <- Object
obj Object -> Text -> wd Double
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Object -> Text -> m a
!: Text
"timestamp"
      Text
level :: Text <- Object
obj Object -> Text -> wd Text
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Object -> Text -> m a
!: Text
"level"
      Text
message :: Text <- Object
obj Object -> Text -> wd Text
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Object -> Text -> m a
!: Text
"text"
      LogEntry -> wd LogEntry
forall a. a -> wd a
forall (m :: * -> *) a. Monad m => a -> m a
return (LogEntry -> wd LogEntry) -> LogEntry -> wd LogEntry
forall a b. (a -> b) -> a -> b
$ LogEntry {
        logTime :: Integer
logTime = Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
timestamp
        , logLevel :: LogLevel
logLevel = Text -> LogLevel
parseChromeLogLevel Text
level
        , logMsg :: Text
logMsg = Text
message
        }
    parseChromeLogEntry Value
v = LogEntry -> wd LogEntry
forall a. a -> wd a
forall (m :: * -> *) a. Monad m => a -> m a
return (LogEntry -> wd LogEntry) -> LogEntry -> wd LogEntry
forall a b. (a -> b) -> a -> b
$ LogEntry {
      logTime :: Integer
logTime = Integer
0
      , logLevel :: LogLevel
logLevel = LogLevel
LogInfo
      , logMsg :: Text
logMsg = Text
"Failed to parse log entry: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogType -> Text
T.pack (Value -> LogType
forall a. Show a => a -> LogType
show Value
v)
      }

    parseChromeLogLevel :: Text -> LogLevel
    parseChromeLogLevel :: Text -> LogLevel
parseChromeLogLevel Text
level = case Text
level of
      Text
"verbose" -> LogLevel
LogDebug
      Text
"debug"   -> LogLevel
LogDebug
      Text
"log"     -> LogLevel
LogInfo
      Text
"info"    -> LogLevel
LogInfo
      Text
"warning" -> LogLevel
LogWarning
      Text
"error"   -> LogLevel
LogSevere
      Text
_         -> LogLevel
LogInfo

getLegacyChromeLogs :: (HasCallStack, WebDriver wd) => LogType -> wd [LogEntry]
getLegacyChromeLogs :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
LogType -> wd [LogEntry]
getLegacyChromeLogs LogType
logType = do
  wd Value -> wd (Either SomeException Value)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (Method -> Text -> Value -> wd Value
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/log" (Value -> wd Value) -> Value -> wd Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"type" Key -> LogType -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LogType
logType]) wd (Either SomeException Value)
-> (Either SomeException Value -> wd [LogEntry]) -> wd [LogEntry]
forall a b. wd a -> (a -> wd b) -> wd b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (Array Array
logs) -> (Value -> wd LogEntry) -> [Value] -> wd [LogEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> wd LogEntry
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => Value -> m a
fromJSON' (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Array
logs)
    Right Value
_ -> [LogEntry] -> wd [LogEntry]
forall a. a -> wd a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Left (SomeException
_ :: SomeException) -> [LogEntry] -> wd [LogEntry]
forall a. a -> wd a
forall (m :: * -> *) a. Monad m => a -> m a
return []