{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}


{- |
= Log

Provides access to log entries.
-}


module CDP.Domains.Log (module CDP.Domains.Log) where

import           Control.Applicative  ((<$>))
import           Control.Monad
import           Control.Monad.Loops
import           Control.Monad.Trans  (liftIO)
import qualified Data.Map             as M
import           Data.Maybe          
import Data.Functor.Identity
import Data.String
import qualified Data.Text as T
import qualified Data.List as List
import qualified Data.Text.IO         as TI
import qualified Data.Vector          as V
import Data.Aeson.Types (Parser(..))
import           Data.Aeson           (FromJSON (..), ToJSON (..), (.:), (.:?), (.=), (.!=), (.:!))
import qualified Data.Aeson           as A
import qualified Network.HTTP.Simple as Http
import qualified Network.URI          as Uri
import qualified Network.WebSockets as WS
import Control.Concurrent
import qualified Data.ByteString.Lazy as BS
import qualified Data.Map as Map
import Data.Proxy
import System.Random
import GHC.Generics
import Data.Char
import Data.Default

import CDP.Internal.Utils


import CDP.Domains.DOMPageNetworkEmulationSecurity as DOMPageNetworkEmulationSecurity
import CDP.Domains.Runtime as Runtime


-- | Type 'Log.LogEntry'.
--   Log entry.
data LogLogEntrySource = LogLogEntrySourceXml | LogLogEntrySourceJavascript | LogLogEntrySourceNetwork | LogLogEntrySourceStorage | LogLogEntrySourceAppcache | LogLogEntrySourceRendering | LogLogEntrySourceSecurity | LogLogEntrySourceDeprecation | LogLogEntrySourceWorker | LogLogEntrySourceViolation | LogLogEntrySourceIntervention | LogLogEntrySourceRecommendation | LogLogEntrySourceOther
  deriving (Eq LogLogEntrySource
Eq LogLogEntrySource
-> (LogLogEntrySource -> LogLogEntrySource -> Ordering)
-> (LogLogEntrySource -> LogLogEntrySource -> Bool)
-> (LogLogEntrySource -> LogLogEntrySource -> Bool)
-> (LogLogEntrySource -> LogLogEntrySource -> Bool)
-> (LogLogEntrySource -> LogLogEntrySource -> Bool)
-> (LogLogEntrySource -> LogLogEntrySource -> LogLogEntrySource)
-> (LogLogEntrySource -> LogLogEntrySource -> LogLogEntrySource)
-> Ord LogLogEntrySource
LogLogEntrySource -> LogLogEntrySource -> Bool
LogLogEntrySource -> LogLogEntrySource -> Ordering
LogLogEntrySource -> LogLogEntrySource -> LogLogEntrySource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLogEntrySource -> LogLogEntrySource -> LogLogEntrySource
$cmin :: LogLogEntrySource -> LogLogEntrySource -> LogLogEntrySource
max :: LogLogEntrySource -> LogLogEntrySource -> LogLogEntrySource
$cmax :: LogLogEntrySource -> LogLogEntrySource -> LogLogEntrySource
>= :: LogLogEntrySource -> LogLogEntrySource -> Bool
$c>= :: LogLogEntrySource -> LogLogEntrySource -> Bool
> :: LogLogEntrySource -> LogLogEntrySource -> Bool
$c> :: LogLogEntrySource -> LogLogEntrySource -> Bool
<= :: LogLogEntrySource -> LogLogEntrySource -> Bool
$c<= :: LogLogEntrySource -> LogLogEntrySource -> Bool
< :: LogLogEntrySource -> LogLogEntrySource -> Bool
$c< :: LogLogEntrySource -> LogLogEntrySource -> Bool
compare :: LogLogEntrySource -> LogLogEntrySource -> Ordering
$ccompare :: LogLogEntrySource -> LogLogEntrySource -> Ordering
$cp1Ord :: Eq LogLogEntrySource
Ord, LogLogEntrySource -> LogLogEntrySource -> Bool
(LogLogEntrySource -> LogLogEntrySource -> Bool)
-> (LogLogEntrySource -> LogLogEntrySource -> Bool)
-> Eq LogLogEntrySource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLogEntrySource -> LogLogEntrySource -> Bool
$c/= :: LogLogEntrySource -> LogLogEntrySource -> Bool
== :: LogLogEntrySource -> LogLogEntrySource -> Bool
$c== :: LogLogEntrySource -> LogLogEntrySource -> Bool
Eq, Int -> LogLogEntrySource -> ShowS
[LogLogEntrySource] -> ShowS
LogLogEntrySource -> String
(Int -> LogLogEntrySource -> ShowS)
-> (LogLogEntrySource -> String)
-> ([LogLogEntrySource] -> ShowS)
-> Show LogLogEntrySource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLogEntrySource] -> ShowS
$cshowList :: [LogLogEntrySource] -> ShowS
show :: LogLogEntrySource -> String
$cshow :: LogLogEntrySource -> String
showsPrec :: Int -> LogLogEntrySource -> ShowS
$cshowsPrec :: Int -> LogLogEntrySource -> ShowS
Show, ReadPrec [LogLogEntrySource]
ReadPrec LogLogEntrySource
Int -> ReadS LogLogEntrySource
ReadS [LogLogEntrySource]
(Int -> ReadS LogLogEntrySource)
-> ReadS [LogLogEntrySource]
-> ReadPrec LogLogEntrySource
-> ReadPrec [LogLogEntrySource]
-> Read LogLogEntrySource
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogLogEntrySource]
$creadListPrec :: ReadPrec [LogLogEntrySource]
readPrec :: ReadPrec LogLogEntrySource
$creadPrec :: ReadPrec LogLogEntrySource
readList :: ReadS [LogLogEntrySource]
$creadList :: ReadS [LogLogEntrySource]
readsPrec :: Int -> ReadS LogLogEntrySource
$creadsPrec :: Int -> ReadS LogLogEntrySource
Read)
instance FromJSON LogLogEntrySource where
  parseJSON :: Value -> Parser LogLogEntrySource
parseJSON = String
-> (Text -> Parser LogLogEntrySource)
-> Value
-> Parser LogLogEntrySource
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"LogLogEntrySource" ((Text -> Parser LogLogEntrySource)
 -> Value -> Parser LogLogEntrySource)
-> (Text -> Parser LogLogEntrySource)
-> Value
-> Parser LogLogEntrySource
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"xml" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceXml
    Text
"javascript" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceJavascript
    Text
"network" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceNetwork
    Text
"storage" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceStorage
    Text
"appcache" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceAppcache
    Text
"rendering" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceRendering
    Text
"security" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceSecurity
    Text
"deprecation" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceDeprecation
    Text
"worker" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceWorker
    Text
"violation" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceViolation
    Text
"intervention" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceIntervention
    Text
"recommendation" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceRecommendation
    Text
"other" -> LogLogEntrySource -> Parser LogLogEntrySource
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntrySource
LogLogEntrySourceOther
    Text
"_" -> String -> Parser LogLogEntrySource
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse LogLogEntrySource"
instance ToJSON LogLogEntrySource where
  toJSON :: LogLogEntrySource -> Value
toJSON LogLogEntrySource
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case LogLogEntrySource
v of
    LogLogEntrySource
LogLogEntrySourceXml -> Text
"xml"
    LogLogEntrySource
LogLogEntrySourceJavascript -> Text
"javascript"
    LogLogEntrySource
LogLogEntrySourceNetwork -> Text
"network"
    LogLogEntrySource
LogLogEntrySourceStorage -> Text
"storage"
    LogLogEntrySource
LogLogEntrySourceAppcache -> Text
"appcache"
    LogLogEntrySource
LogLogEntrySourceRendering -> Text
"rendering"
    LogLogEntrySource
LogLogEntrySourceSecurity -> Text
"security"
    LogLogEntrySource
LogLogEntrySourceDeprecation -> Text
"deprecation"
    LogLogEntrySource
LogLogEntrySourceWorker -> Text
"worker"
    LogLogEntrySource
LogLogEntrySourceViolation -> Text
"violation"
    LogLogEntrySource
LogLogEntrySourceIntervention -> Text
"intervention"
    LogLogEntrySource
LogLogEntrySourceRecommendation -> Text
"recommendation"
    LogLogEntrySource
LogLogEntrySourceOther -> Text
"other"
data LogLogEntryLevel = LogLogEntryLevelVerbose | LogLogEntryLevelInfo | LogLogEntryLevelWarning | LogLogEntryLevelError
  deriving (Eq LogLogEntryLevel
Eq LogLogEntryLevel
-> (LogLogEntryLevel -> LogLogEntryLevel -> Ordering)
-> (LogLogEntryLevel -> LogLogEntryLevel -> Bool)
-> (LogLogEntryLevel -> LogLogEntryLevel -> Bool)
-> (LogLogEntryLevel -> LogLogEntryLevel -> Bool)
-> (LogLogEntryLevel -> LogLogEntryLevel -> Bool)
-> (LogLogEntryLevel -> LogLogEntryLevel -> LogLogEntryLevel)
-> (LogLogEntryLevel -> LogLogEntryLevel -> LogLogEntryLevel)
-> Ord LogLogEntryLevel
LogLogEntryLevel -> LogLogEntryLevel -> Bool
LogLogEntryLevel -> LogLogEntryLevel -> Ordering
LogLogEntryLevel -> LogLogEntryLevel -> LogLogEntryLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLogEntryLevel -> LogLogEntryLevel -> LogLogEntryLevel
$cmin :: LogLogEntryLevel -> LogLogEntryLevel -> LogLogEntryLevel
max :: LogLogEntryLevel -> LogLogEntryLevel -> LogLogEntryLevel
$cmax :: LogLogEntryLevel -> LogLogEntryLevel -> LogLogEntryLevel
>= :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
$c>= :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
> :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
$c> :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
<= :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
$c<= :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
< :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
$c< :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
compare :: LogLogEntryLevel -> LogLogEntryLevel -> Ordering
$ccompare :: LogLogEntryLevel -> LogLogEntryLevel -> Ordering
$cp1Ord :: Eq LogLogEntryLevel
Ord, LogLogEntryLevel -> LogLogEntryLevel -> Bool
(LogLogEntryLevel -> LogLogEntryLevel -> Bool)
-> (LogLogEntryLevel -> LogLogEntryLevel -> Bool)
-> Eq LogLogEntryLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
$c/= :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
== :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
$c== :: LogLogEntryLevel -> LogLogEntryLevel -> Bool
Eq, Int -> LogLogEntryLevel -> ShowS
[LogLogEntryLevel] -> ShowS
LogLogEntryLevel -> String
(Int -> LogLogEntryLevel -> ShowS)
-> (LogLogEntryLevel -> String)
-> ([LogLogEntryLevel] -> ShowS)
-> Show LogLogEntryLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLogEntryLevel] -> ShowS
$cshowList :: [LogLogEntryLevel] -> ShowS
show :: LogLogEntryLevel -> String
$cshow :: LogLogEntryLevel -> String
showsPrec :: Int -> LogLogEntryLevel -> ShowS
$cshowsPrec :: Int -> LogLogEntryLevel -> ShowS
Show, ReadPrec [LogLogEntryLevel]
ReadPrec LogLogEntryLevel
Int -> ReadS LogLogEntryLevel
ReadS [LogLogEntryLevel]
(Int -> ReadS LogLogEntryLevel)
-> ReadS [LogLogEntryLevel]
-> ReadPrec LogLogEntryLevel
-> ReadPrec [LogLogEntryLevel]
-> Read LogLogEntryLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogLogEntryLevel]
$creadListPrec :: ReadPrec [LogLogEntryLevel]
readPrec :: ReadPrec LogLogEntryLevel
$creadPrec :: ReadPrec LogLogEntryLevel
readList :: ReadS [LogLogEntryLevel]
$creadList :: ReadS [LogLogEntryLevel]
readsPrec :: Int -> ReadS LogLogEntryLevel
$creadsPrec :: Int -> ReadS LogLogEntryLevel
Read)
instance FromJSON LogLogEntryLevel where
  parseJSON :: Value -> Parser LogLogEntryLevel
parseJSON = String
-> (Text -> Parser LogLogEntryLevel)
-> Value
-> Parser LogLogEntryLevel
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"LogLogEntryLevel" ((Text -> Parser LogLogEntryLevel)
 -> Value -> Parser LogLogEntryLevel)
-> (Text -> Parser LogLogEntryLevel)
-> Value
-> Parser LogLogEntryLevel
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"verbose" -> LogLogEntryLevel -> Parser LogLogEntryLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntryLevel
LogLogEntryLevelVerbose
    Text
"info" -> LogLogEntryLevel -> Parser LogLogEntryLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntryLevel
LogLogEntryLevelInfo
    Text
"warning" -> LogLogEntryLevel -> Parser LogLogEntryLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntryLevel
LogLogEntryLevelWarning
    Text
"error" -> LogLogEntryLevel -> Parser LogLogEntryLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntryLevel
LogLogEntryLevelError
    Text
"_" -> String -> Parser LogLogEntryLevel
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse LogLogEntryLevel"
instance ToJSON LogLogEntryLevel where
  toJSON :: LogLogEntryLevel -> Value
toJSON LogLogEntryLevel
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case LogLogEntryLevel
v of
    LogLogEntryLevel
LogLogEntryLevelVerbose -> Text
"verbose"
    LogLogEntryLevel
LogLogEntryLevelInfo -> Text
"info"
    LogLogEntryLevel
LogLogEntryLevelWarning -> Text
"warning"
    LogLogEntryLevel
LogLogEntryLevelError -> Text
"error"
data LogLogEntryCategory = LogLogEntryCategoryCors
  deriving (Eq LogLogEntryCategory
Eq LogLogEntryCategory
-> (LogLogEntryCategory -> LogLogEntryCategory -> Ordering)
-> (LogLogEntryCategory -> LogLogEntryCategory -> Bool)
-> (LogLogEntryCategory -> LogLogEntryCategory -> Bool)
-> (LogLogEntryCategory -> LogLogEntryCategory -> Bool)
-> (LogLogEntryCategory -> LogLogEntryCategory -> Bool)
-> (LogLogEntryCategory
    -> LogLogEntryCategory -> LogLogEntryCategory)
-> (LogLogEntryCategory
    -> LogLogEntryCategory -> LogLogEntryCategory)
-> Ord LogLogEntryCategory
LogLogEntryCategory -> LogLogEntryCategory -> Bool
LogLogEntryCategory -> LogLogEntryCategory -> Ordering
LogLogEntryCategory -> LogLogEntryCategory -> LogLogEntryCategory
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLogEntryCategory -> LogLogEntryCategory -> LogLogEntryCategory
$cmin :: LogLogEntryCategory -> LogLogEntryCategory -> LogLogEntryCategory
max :: LogLogEntryCategory -> LogLogEntryCategory -> LogLogEntryCategory
$cmax :: LogLogEntryCategory -> LogLogEntryCategory -> LogLogEntryCategory
>= :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
$c>= :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
> :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
$c> :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
<= :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
$c<= :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
< :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
$c< :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
compare :: LogLogEntryCategory -> LogLogEntryCategory -> Ordering
$ccompare :: LogLogEntryCategory -> LogLogEntryCategory -> Ordering
$cp1Ord :: Eq LogLogEntryCategory
Ord, LogLogEntryCategory -> LogLogEntryCategory -> Bool
(LogLogEntryCategory -> LogLogEntryCategory -> Bool)
-> (LogLogEntryCategory -> LogLogEntryCategory -> Bool)
-> Eq LogLogEntryCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
$c/= :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
== :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
$c== :: LogLogEntryCategory -> LogLogEntryCategory -> Bool
Eq, Int -> LogLogEntryCategory -> ShowS
[LogLogEntryCategory] -> ShowS
LogLogEntryCategory -> String
(Int -> LogLogEntryCategory -> ShowS)
-> (LogLogEntryCategory -> String)
-> ([LogLogEntryCategory] -> ShowS)
-> Show LogLogEntryCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLogEntryCategory] -> ShowS
$cshowList :: [LogLogEntryCategory] -> ShowS
show :: LogLogEntryCategory -> String
$cshow :: LogLogEntryCategory -> String
showsPrec :: Int -> LogLogEntryCategory -> ShowS
$cshowsPrec :: Int -> LogLogEntryCategory -> ShowS
Show, ReadPrec [LogLogEntryCategory]
ReadPrec LogLogEntryCategory
Int -> ReadS LogLogEntryCategory
ReadS [LogLogEntryCategory]
(Int -> ReadS LogLogEntryCategory)
-> ReadS [LogLogEntryCategory]
-> ReadPrec LogLogEntryCategory
-> ReadPrec [LogLogEntryCategory]
-> Read LogLogEntryCategory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogLogEntryCategory]
$creadListPrec :: ReadPrec [LogLogEntryCategory]
readPrec :: ReadPrec LogLogEntryCategory
$creadPrec :: ReadPrec LogLogEntryCategory
readList :: ReadS [LogLogEntryCategory]
$creadList :: ReadS [LogLogEntryCategory]
readsPrec :: Int -> ReadS LogLogEntryCategory
$creadsPrec :: Int -> ReadS LogLogEntryCategory
Read)
instance FromJSON LogLogEntryCategory where
  parseJSON :: Value -> Parser LogLogEntryCategory
parseJSON = String
-> (Text -> Parser LogLogEntryCategory)
-> Value
-> Parser LogLogEntryCategory
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"LogLogEntryCategory" ((Text -> Parser LogLogEntryCategory)
 -> Value -> Parser LogLogEntryCategory)
-> (Text -> Parser LogLogEntryCategory)
-> Value
-> Parser LogLogEntryCategory
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"cors" -> LogLogEntryCategory -> Parser LogLogEntryCategory
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLogEntryCategory
LogLogEntryCategoryCors
    Text
"_" -> String -> Parser LogLogEntryCategory
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse LogLogEntryCategory"
instance ToJSON LogLogEntryCategory where
  toJSON :: LogLogEntryCategory -> Value
toJSON LogLogEntryCategory
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case LogLogEntryCategory
v of
    LogLogEntryCategory
LogLogEntryCategoryCors -> Text
"cors"
data LogLogEntry = LogLogEntry
  {
    -- | Log entry source.
    LogLogEntry -> LogLogEntrySource
logLogEntrySource :: LogLogEntrySource,
    -- | Log entry severity.
    LogLogEntry -> LogLogEntryLevel
logLogEntryLevel :: LogLogEntryLevel,
    -- | Logged text.
    LogLogEntry -> Text
logLogEntryText :: T.Text,
    LogLogEntry -> Maybe LogLogEntryCategory
logLogEntryCategory :: Maybe LogLogEntryCategory,
    -- | Timestamp when this entry was added.
    LogLogEntry -> RuntimeTimestamp
logLogEntryTimestamp :: Runtime.RuntimeTimestamp,
    -- | URL of the resource if known.
    LogLogEntry -> Maybe Text
logLogEntryUrl :: Maybe T.Text,
    -- | Line number in the resource.
    LogLogEntry -> Maybe Int
logLogEntryLineNumber :: Maybe Int,
    -- | JavaScript stack trace.
    LogLogEntry -> Maybe RuntimeStackTrace
logLogEntryStackTrace :: Maybe Runtime.RuntimeStackTrace,
    -- | Identifier of the network request associated with this entry.
    LogLogEntry -> Maybe Text
logLogEntryNetworkRequestId :: Maybe DOMPageNetworkEmulationSecurity.NetworkRequestId,
    -- | Identifier of the worker associated with this entry.
    LogLogEntry -> Maybe Text
logLogEntryWorkerId :: Maybe T.Text,
    -- | Call arguments.
    LogLogEntry -> Maybe [RuntimeRemoteObject]
logLogEntryArgs :: Maybe [Runtime.RuntimeRemoteObject]
  }
  deriving (LogLogEntry -> LogLogEntry -> Bool
(LogLogEntry -> LogLogEntry -> Bool)
-> (LogLogEntry -> LogLogEntry -> Bool) -> Eq LogLogEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLogEntry -> LogLogEntry -> Bool
$c/= :: LogLogEntry -> LogLogEntry -> Bool
== :: LogLogEntry -> LogLogEntry -> Bool
$c== :: LogLogEntry -> LogLogEntry -> Bool
Eq, Int -> LogLogEntry -> ShowS
[LogLogEntry] -> ShowS
LogLogEntry -> String
(Int -> LogLogEntry -> ShowS)
-> (LogLogEntry -> String)
-> ([LogLogEntry] -> ShowS)
-> Show LogLogEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLogEntry] -> ShowS
$cshowList :: [LogLogEntry] -> ShowS
show :: LogLogEntry -> String
$cshow :: LogLogEntry -> String
showsPrec :: Int -> LogLogEntry -> ShowS
$cshowsPrec :: Int -> LogLogEntry -> ShowS
Show)
instance FromJSON LogLogEntry where
  parseJSON :: Value -> Parser LogLogEntry
parseJSON = String
-> (Object -> Parser LogLogEntry) -> Value -> Parser LogLogEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LogLogEntry" ((Object -> Parser LogLogEntry) -> Value -> Parser LogLogEntry)
-> (Object -> Parser LogLogEntry) -> Value -> Parser LogLogEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> LogLogEntrySource
-> LogLogEntryLevel
-> Text
-> Maybe LogLogEntryCategory
-> RuntimeTimestamp
-> Maybe Text
-> Maybe Int
-> Maybe RuntimeStackTrace
-> Maybe Text
-> Maybe Text
-> Maybe [RuntimeRemoteObject]
-> LogLogEntry
LogLogEntry
    (LogLogEntrySource
 -> LogLogEntryLevel
 -> Text
 -> Maybe LogLogEntryCategory
 -> RuntimeTimestamp
 -> Maybe Text
 -> Maybe Int
 -> Maybe RuntimeStackTrace
 -> Maybe Text
 -> Maybe Text
 -> Maybe [RuntimeRemoteObject]
 -> LogLogEntry)
-> Parser LogLogEntrySource
-> Parser
     (LogLogEntryLevel
      -> Text
      -> Maybe LogLogEntryCategory
      -> RuntimeTimestamp
      -> Maybe Text
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Text
      -> Maybe Text
      -> Maybe [RuntimeRemoteObject]
      -> LogLogEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser LogLogEntrySource
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"source"
    Parser
  (LogLogEntryLevel
   -> Text
   -> Maybe LogLogEntryCategory
   -> RuntimeTimestamp
   -> Maybe Text
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Text
   -> Maybe Text
   -> Maybe [RuntimeRemoteObject]
   -> LogLogEntry)
-> Parser LogLogEntryLevel
-> Parser
     (Text
      -> Maybe LogLogEntryCategory
      -> RuntimeTimestamp
      -> Maybe Text
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Text
      -> Maybe Text
      -> Maybe [RuntimeRemoteObject]
      -> LogLogEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser LogLogEntryLevel
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"level"
    Parser
  (Text
   -> Maybe LogLogEntryCategory
   -> RuntimeTimestamp
   -> Maybe Text
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Text
   -> Maybe Text
   -> Maybe [RuntimeRemoteObject]
   -> LogLogEntry)
-> Parser Text
-> Parser
     (Maybe LogLogEntryCategory
      -> RuntimeTimestamp
      -> Maybe Text
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Text
      -> Maybe Text
      -> Maybe [RuntimeRemoteObject]
      -> LogLogEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"text"
    Parser
  (Maybe LogLogEntryCategory
   -> RuntimeTimestamp
   -> Maybe Text
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Text
   -> Maybe Text
   -> Maybe [RuntimeRemoteObject]
   -> LogLogEntry)
-> Parser (Maybe LogLogEntryCategory)
-> Parser
     (RuntimeTimestamp
      -> Maybe Text
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Text
      -> Maybe Text
      -> Maybe [RuntimeRemoteObject]
      -> LogLogEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe LogLogEntryCategory)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"category"
    Parser
  (RuntimeTimestamp
   -> Maybe Text
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Text
   -> Maybe Text
   -> Maybe [RuntimeRemoteObject]
   -> LogLogEntry)
-> Parser RuntimeTimestamp
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Text
      -> Maybe Text
      -> Maybe [RuntimeRemoteObject]
      -> LogLogEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RuntimeTimestamp
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"timestamp"
    Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Text
   -> Maybe Text
   -> Maybe [RuntimeRemoteObject]
   -> LogLogEntry)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe RuntimeStackTrace
      -> Maybe Text
      -> Maybe Text
      -> Maybe [RuntimeRemoteObject]
      -> LogLogEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"url"
    Parser
  (Maybe Int
   -> Maybe RuntimeStackTrace
   -> Maybe Text
   -> Maybe Text
   -> Maybe [RuntimeRemoteObject]
   -> LogLogEntry)
-> Parser (Maybe Int)
-> Parser
     (Maybe RuntimeStackTrace
      -> Maybe Text
      -> Maybe Text
      -> Maybe [RuntimeRemoteObject]
      -> LogLogEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"lineNumber"
    Parser
  (Maybe RuntimeStackTrace
   -> Maybe Text
   -> Maybe Text
   -> Maybe [RuntimeRemoteObject]
   -> LogLogEntry)
-> Parser (Maybe RuntimeStackTrace)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe [RuntimeRemoteObject] -> LogLogEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeStackTrace)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"stackTrace"
    Parser
  (Maybe Text
   -> Maybe Text -> Maybe [RuntimeRemoteObject] -> LogLogEntry)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe [RuntimeRemoteObject] -> LogLogEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"networkRequestId"
    Parser (Maybe Text -> Maybe [RuntimeRemoteObject] -> LogLogEntry)
-> Parser (Maybe Text)
-> Parser (Maybe [RuntimeRemoteObject] -> LogLogEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"workerId"
    Parser (Maybe [RuntimeRemoteObject] -> LogLogEntry)
-> Parser (Maybe [RuntimeRemoteObject]) -> Parser LogLogEntry
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [RuntimeRemoteObject])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"args"
instance ToJSON LogLogEntry where
  toJSON :: LogLogEntry -> Value
toJSON LogLogEntry
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"source" Text -> LogLogEntrySource -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (LogLogEntrySource -> Pair)
-> Maybe LogLogEntrySource -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogLogEntrySource -> Maybe LogLogEntrySource
forall a. a -> Maybe a
Just (LogLogEntry -> LogLogEntrySource
logLogEntrySource LogLogEntry
p),
    (Text
"level" Text -> LogLogEntryLevel -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (LogLogEntryLevel -> Pair) -> Maybe LogLogEntryLevel -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogLogEntryLevel -> Maybe LogLogEntryLevel
forall a. a -> Maybe a
Just (LogLogEntry -> LogLogEntryLevel
logLogEntryLevel LogLogEntry
p),
    (Text
"text" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (LogLogEntry -> Text
logLogEntryText LogLogEntry
p),
    (Text
"category" Text -> LogLogEntryCategory -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (LogLogEntryCategory -> Pair)
-> Maybe LogLogEntryCategory -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LogLogEntry -> Maybe LogLogEntryCategory
logLogEntryCategory LogLogEntry
p),
    (Text
"timestamp" Text -> RuntimeTimestamp -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeTimestamp -> Pair) -> Maybe RuntimeTimestamp -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeTimestamp -> Maybe RuntimeTimestamp
forall a. a -> Maybe a
Just (LogLogEntry -> RuntimeTimestamp
logLogEntryTimestamp LogLogEntry
p),
    (Text
"url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LogLogEntry -> Maybe Text
logLogEntryUrl LogLogEntry
p),
    (Text
"lineNumber" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LogLogEntry -> Maybe Int
logLogEntryLineNumber LogLogEntry
p),
    (Text
"stackTrace" Text -> RuntimeStackTrace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeStackTrace -> Pair)
-> Maybe RuntimeStackTrace -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LogLogEntry -> Maybe RuntimeStackTrace
logLogEntryStackTrace LogLogEntry
p),
    (Text
"networkRequestId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LogLogEntry -> Maybe Text
logLogEntryNetworkRequestId LogLogEntry
p),
    (Text
"workerId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LogLogEntry -> Maybe Text
logLogEntryWorkerId LogLogEntry
p),
    (Text
"args" Text -> [RuntimeRemoteObject] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([RuntimeRemoteObject] -> Pair)
-> Maybe [RuntimeRemoteObject] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LogLogEntry -> Maybe [RuntimeRemoteObject]
logLogEntryArgs LogLogEntry
p)
    ]

-- | Type 'Log.ViolationSetting'.
--   Violation configuration setting.
data LogViolationSettingName = LogViolationSettingNameLongTask | LogViolationSettingNameLongLayout | LogViolationSettingNameBlockedEvent | LogViolationSettingNameBlockedParser | LogViolationSettingNameDiscouragedAPIUse | LogViolationSettingNameHandler | LogViolationSettingNameRecurringHandler
  deriving (Eq LogViolationSettingName
Eq LogViolationSettingName
-> (LogViolationSettingName -> LogViolationSettingName -> Ordering)
-> (LogViolationSettingName -> LogViolationSettingName -> Bool)
-> (LogViolationSettingName -> LogViolationSettingName -> Bool)
-> (LogViolationSettingName -> LogViolationSettingName -> Bool)
-> (LogViolationSettingName -> LogViolationSettingName -> Bool)
-> (LogViolationSettingName
    -> LogViolationSettingName -> LogViolationSettingName)
-> (LogViolationSettingName
    -> LogViolationSettingName -> LogViolationSettingName)
-> Ord LogViolationSettingName
LogViolationSettingName -> LogViolationSettingName -> Bool
LogViolationSettingName -> LogViolationSettingName -> Ordering
LogViolationSettingName
-> LogViolationSettingName -> LogViolationSettingName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogViolationSettingName
-> LogViolationSettingName -> LogViolationSettingName
$cmin :: LogViolationSettingName
-> LogViolationSettingName -> LogViolationSettingName
max :: LogViolationSettingName
-> LogViolationSettingName -> LogViolationSettingName
$cmax :: LogViolationSettingName
-> LogViolationSettingName -> LogViolationSettingName
>= :: LogViolationSettingName -> LogViolationSettingName -> Bool
$c>= :: LogViolationSettingName -> LogViolationSettingName -> Bool
> :: LogViolationSettingName -> LogViolationSettingName -> Bool
$c> :: LogViolationSettingName -> LogViolationSettingName -> Bool
<= :: LogViolationSettingName -> LogViolationSettingName -> Bool
$c<= :: LogViolationSettingName -> LogViolationSettingName -> Bool
< :: LogViolationSettingName -> LogViolationSettingName -> Bool
$c< :: LogViolationSettingName -> LogViolationSettingName -> Bool
compare :: LogViolationSettingName -> LogViolationSettingName -> Ordering
$ccompare :: LogViolationSettingName -> LogViolationSettingName -> Ordering
$cp1Ord :: Eq LogViolationSettingName
Ord, LogViolationSettingName -> LogViolationSettingName -> Bool
(LogViolationSettingName -> LogViolationSettingName -> Bool)
-> (LogViolationSettingName -> LogViolationSettingName -> Bool)
-> Eq LogViolationSettingName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogViolationSettingName -> LogViolationSettingName -> Bool
$c/= :: LogViolationSettingName -> LogViolationSettingName -> Bool
== :: LogViolationSettingName -> LogViolationSettingName -> Bool
$c== :: LogViolationSettingName -> LogViolationSettingName -> Bool
Eq, Int -> LogViolationSettingName -> ShowS
[LogViolationSettingName] -> ShowS
LogViolationSettingName -> String
(Int -> LogViolationSettingName -> ShowS)
-> (LogViolationSettingName -> String)
-> ([LogViolationSettingName] -> ShowS)
-> Show LogViolationSettingName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogViolationSettingName] -> ShowS
$cshowList :: [LogViolationSettingName] -> ShowS
show :: LogViolationSettingName -> String
$cshow :: LogViolationSettingName -> String
showsPrec :: Int -> LogViolationSettingName -> ShowS
$cshowsPrec :: Int -> LogViolationSettingName -> ShowS
Show, ReadPrec [LogViolationSettingName]
ReadPrec LogViolationSettingName
Int -> ReadS LogViolationSettingName
ReadS [LogViolationSettingName]
(Int -> ReadS LogViolationSettingName)
-> ReadS [LogViolationSettingName]
-> ReadPrec LogViolationSettingName
-> ReadPrec [LogViolationSettingName]
-> Read LogViolationSettingName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogViolationSettingName]
$creadListPrec :: ReadPrec [LogViolationSettingName]
readPrec :: ReadPrec LogViolationSettingName
$creadPrec :: ReadPrec LogViolationSettingName
readList :: ReadS [LogViolationSettingName]
$creadList :: ReadS [LogViolationSettingName]
readsPrec :: Int -> ReadS LogViolationSettingName
$creadsPrec :: Int -> ReadS LogViolationSettingName
Read)
instance FromJSON LogViolationSettingName where
  parseJSON :: Value -> Parser LogViolationSettingName
parseJSON = String
-> (Text -> Parser LogViolationSettingName)
-> Value
-> Parser LogViolationSettingName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"LogViolationSettingName" ((Text -> Parser LogViolationSettingName)
 -> Value -> Parser LogViolationSettingName)
-> (Text -> Parser LogViolationSettingName)
-> Value
-> Parser LogViolationSettingName
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"longTask" -> LogViolationSettingName -> Parser LogViolationSettingName
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogViolationSettingName
LogViolationSettingNameLongTask
    Text
"longLayout" -> LogViolationSettingName -> Parser LogViolationSettingName
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogViolationSettingName
LogViolationSettingNameLongLayout
    Text
"blockedEvent" -> LogViolationSettingName -> Parser LogViolationSettingName
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogViolationSettingName
LogViolationSettingNameBlockedEvent
    Text
"blockedParser" -> LogViolationSettingName -> Parser LogViolationSettingName
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogViolationSettingName
LogViolationSettingNameBlockedParser
    Text
"discouragedAPIUse" -> LogViolationSettingName -> Parser LogViolationSettingName
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogViolationSettingName
LogViolationSettingNameDiscouragedAPIUse
    Text
"handler" -> LogViolationSettingName -> Parser LogViolationSettingName
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogViolationSettingName
LogViolationSettingNameHandler
    Text
"recurringHandler" -> LogViolationSettingName -> Parser LogViolationSettingName
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogViolationSettingName
LogViolationSettingNameRecurringHandler
    Text
"_" -> String -> Parser LogViolationSettingName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse LogViolationSettingName"
instance ToJSON LogViolationSettingName where
  toJSON :: LogViolationSettingName -> Value
toJSON LogViolationSettingName
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case LogViolationSettingName
v of
    LogViolationSettingName
LogViolationSettingNameLongTask -> Text
"longTask"
    LogViolationSettingName
LogViolationSettingNameLongLayout -> Text
"longLayout"
    LogViolationSettingName
LogViolationSettingNameBlockedEvent -> Text
"blockedEvent"
    LogViolationSettingName
LogViolationSettingNameBlockedParser -> Text
"blockedParser"
    LogViolationSettingName
LogViolationSettingNameDiscouragedAPIUse -> Text
"discouragedAPIUse"
    LogViolationSettingName
LogViolationSettingNameHandler -> Text
"handler"
    LogViolationSettingName
LogViolationSettingNameRecurringHandler -> Text
"recurringHandler"
data LogViolationSetting = LogViolationSetting
  {
    -- | Violation type.
    LogViolationSetting -> LogViolationSettingName
logViolationSettingName :: LogViolationSettingName,
    -- | Time threshold to trigger upon.
    LogViolationSetting -> RuntimeTimestamp
logViolationSettingThreshold :: Double
  }
  deriving (LogViolationSetting -> LogViolationSetting -> Bool
(LogViolationSetting -> LogViolationSetting -> Bool)
-> (LogViolationSetting -> LogViolationSetting -> Bool)
-> Eq LogViolationSetting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogViolationSetting -> LogViolationSetting -> Bool
$c/= :: LogViolationSetting -> LogViolationSetting -> Bool
== :: LogViolationSetting -> LogViolationSetting -> Bool
$c== :: LogViolationSetting -> LogViolationSetting -> Bool
Eq, Int -> LogViolationSetting -> ShowS
[LogViolationSetting] -> ShowS
LogViolationSetting -> String
(Int -> LogViolationSetting -> ShowS)
-> (LogViolationSetting -> String)
-> ([LogViolationSetting] -> ShowS)
-> Show LogViolationSetting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogViolationSetting] -> ShowS
$cshowList :: [LogViolationSetting] -> ShowS
show :: LogViolationSetting -> String
$cshow :: LogViolationSetting -> String
showsPrec :: Int -> LogViolationSetting -> ShowS
$cshowsPrec :: Int -> LogViolationSetting -> ShowS
Show)
instance FromJSON LogViolationSetting where
  parseJSON :: Value -> Parser LogViolationSetting
parseJSON = String
-> (Object -> Parser LogViolationSetting)
-> Value
-> Parser LogViolationSetting
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LogViolationSetting" ((Object -> Parser LogViolationSetting)
 -> Value -> Parser LogViolationSetting)
-> (Object -> Parser LogViolationSetting)
-> Value
-> Parser LogViolationSetting
forall a b. (a -> b) -> a -> b
$ \Object
o -> LogViolationSettingName -> RuntimeTimestamp -> LogViolationSetting
LogViolationSetting
    (LogViolationSettingName
 -> RuntimeTimestamp -> LogViolationSetting)
-> Parser LogViolationSettingName
-> Parser (RuntimeTimestamp -> LogViolationSetting)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser LogViolationSettingName
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser (RuntimeTimestamp -> LogViolationSetting)
-> Parser RuntimeTimestamp -> Parser LogViolationSetting
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RuntimeTimestamp
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"threshold"
instance ToJSON LogViolationSetting where
  toJSON :: LogViolationSetting -> Value
toJSON LogViolationSetting
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> LogViolationSettingName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (LogViolationSettingName -> Pair)
-> Maybe LogViolationSettingName -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogViolationSettingName -> Maybe LogViolationSettingName
forall a. a -> Maybe a
Just (LogViolationSetting -> LogViolationSettingName
logViolationSettingName LogViolationSetting
p),
    (Text
"threshold" Text -> RuntimeTimestamp -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeTimestamp -> Pair) -> Maybe RuntimeTimestamp -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeTimestamp -> Maybe RuntimeTimestamp
forall a. a -> Maybe a
Just (LogViolationSetting -> RuntimeTimestamp
logViolationSettingThreshold LogViolationSetting
p)
    ]

-- | Type of the 'Log.entryAdded' event.
data LogEntryAdded = LogEntryAdded
  {
    -- | The entry.
    LogEntryAdded -> LogLogEntry
logEntryAddedEntry :: LogLogEntry
  }
  deriving (LogEntryAdded -> LogEntryAdded -> Bool
(LogEntryAdded -> LogEntryAdded -> Bool)
-> (LogEntryAdded -> LogEntryAdded -> Bool) -> Eq LogEntryAdded
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogEntryAdded -> LogEntryAdded -> Bool
$c/= :: LogEntryAdded -> LogEntryAdded -> Bool
== :: LogEntryAdded -> LogEntryAdded -> Bool
$c== :: LogEntryAdded -> LogEntryAdded -> Bool
Eq, Int -> LogEntryAdded -> ShowS
[LogEntryAdded] -> ShowS
LogEntryAdded -> String
(Int -> LogEntryAdded -> ShowS)
-> (LogEntryAdded -> String)
-> ([LogEntryAdded] -> ShowS)
-> Show LogEntryAdded
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogEntryAdded] -> ShowS
$cshowList :: [LogEntryAdded] -> ShowS
show :: LogEntryAdded -> String
$cshow :: LogEntryAdded -> String
showsPrec :: Int -> LogEntryAdded -> ShowS
$cshowsPrec :: Int -> LogEntryAdded -> ShowS
Show)
instance FromJSON LogEntryAdded where
  parseJSON :: Value -> Parser LogEntryAdded
parseJSON = String
-> (Object -> Parser LogEntryAdded)
-> Value
-> Parser LogEntryAdded
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LogEntryAdded" ((Object -> Parser LogEntryAdded) -> Value -> Parser LogEntryAdded)
-> (Object -> Parser LogEntryAdded)
-> Value
-> Parser LogEntryAdded
forall a b. (a -> b) -> a -> b
$ \Object
o -> LogLogEntry -> LogEntryAdded
LogEntryAdded
    (LogLogEntry -> LogEntryAdded)
-> Parser LogLogEntry -> Parser LogEntryAdded
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser LogLogEntry
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"entry"
instance Event LogEntryAdded where
  eventName :: Proxy LogEntryAdded -> String
eventName Proxy LogEntryAdded
_ = String
"Log.entryAdded"

-- | Clears the log.

-- | Parameters of the 'Log.clear' command.
data PLogClear = PLogClear
  deriving (PLogClear -> PLogClear -> Bool
(PLogClear -> PLogClear -> Bool)
-> (PLogClear -> PLogClear -> Bool) -> Eq PLogClear
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLogClear -> PLogClear -> Bool
$c/= :: PLogClear -> PLogClear -> Bool
== :: PLogClear -> PLogClear -> Bool
$c== :: PLogClear -> PLogClear -> Bool
Eq, Int -> PLogClear -> ShowS
[PLogClear] -> ShowS
PLogClear -> String
(Int -> PLogClear -> ShowS)
-> (PLogClear -> String)
-> ([PLogClear] -> ShowS)
-> Show PLogClear
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLogClear] -> ShowS
$cshowList :: [PLogClear] -> ShowS
show :: PLogClear -> String
$cshow :: PLogClear -> String
showsPrec :: Int -> PLogClear -> ShowS
$cshowsPrec :: Int -> PLogClear -> ShowS
Show)
pLogClear
  :: PLogClear
pLogClear :: PLogClear
pLogClear
  = PLogClear
PLogClear
instance ToJSON PLogClear where
  toJSON :: PLogClear -> Value
toJSON PLogClear
_ = Value
A.Null
instance Command PLogClear where
  type CommandResponse PLogClear = ()
  commandName :: Proxy PLogClear -> String
commandName Proxy PLogClear
_ = String
"Log.clear"
  fromJSON :: Proxy PLogClear -> Value -> Result (CommandResponse PLogClear)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PLogClear -> Result ())
-> Proxy PLogClear
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PLogClear -> ()) -> Proxy PLogClear -> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PLogClear -> ()
forall a b. a -> b -> a
const ()

-- | Disables log domain, prevents further log entries from being reported to the client.

-- | Parameters of the 'Log.disable' command.
data PLogDisable = PLogDisable
  deriving (PLogDisable -> PLogDisable -> Bool
(PLogDisable -> PLogDisable -> Bool)
-> (PLogDisable -> PLogDisable -> Bool) -> Eq PLogDisable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLogDisable -> PLogDisable -> Bool
$c/= :: PLogDisable -> PLogDisable -> Bool
== :: PLogDisable -> PLogDisable -> Bool
$c== :: PLogDisable -> PLogDisable -> Bool
Eq, Int -> PLogDisable -> ShowS
[PLogDisable] -> ShowS
PLogDisable -> String
(Int -> PLogDisable -> ShowS)
-> (PLogDisable -> String)
-> ([PLogDisable] -> ShowS)
-> Show PLogDisable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLogDisable] -> ShowS
$cshowList :: [PLogDisable] -> ShowS
show :: PLogDisable -> String
$cshow :: PLogDisable -> String
showsPrec :: Int -> PLogDisable -> ShowS
$cshowsPrec :: Int -> PLogDisable -> ShowS
Show)
pLogDisable
  :: PLogDisable
pLogDisable :: PLogDisable
pLogDisable
  = PLogDisable
PLogDisable
instance ToJSON PLogDisable where
  toJSON :: PLogDisable -> Value
toJSON PLogDisable
_ = Value
A.Null
instance Command PLogDisable where
  type CommandResponse PLogDisable = ()
  commandName :: Proxy PLogDisable -> String
commandName Proxy PLogDisable
_ = String
"Log.disable"
  fromJSON :: Proxy PLogDisable -> Value -> Result (CommandResponse PLogDisable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PLogDisable -> Result ())
-> Proxy PLogDisable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PLogDisable -> ()) -> Proxy PLogDisable -> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PLogDisable -> ()
forall a b. a -> b -> a
const ()

-- | Enables log domain, sends the entries collected so far to the client by means of the
--   `entryAdded` notification.

-- | Parameters of the 'Log.enable' command.
data PLogEnable = PLogEnable
  deriving (PLogEnable -> PLogEnable -> Bool
(PLogEnable -> PLogEnable -> Bool)
-> (PLogEnable -> PLogEnable -> Bool) -> Eq PLogEnable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLogEnable -> PLogEnable -> Bool
$c/= :: PLogEnable -> PLogEnable -> Bool
== :: PLogEnable -> PLogEnable -> Bool
$c== :: PLogEnable -> PLogEnable -> Bool
Eq, Int -> PLogEnable -> ShowS
[PLogEnable] -> ShowS
PLogEnable -> String
(Int -> PLogEnable -> ShowS)
-> (PLogEnable -> String)
-> ([PLogEnable] -> ShowS)
-> Show PLogEnable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLogEnable] -> ShowS
$cshowList :: [PLogEnable] -> ShowS
show :: PLogEnable -> String
$cshow :: PLogEnable -> String
showsPrec :: Int -> PLogEnable -> ShowS
$cshowsPrec :: Int -> PLogEnable -> ShowS
Show)
pLogEnable
  :: PLogEnable
pLogEnable :: PLogEnable
pLogEnable
  = PLogEnable
PLogEnable
instance ToJSON PLogEnable where
  toJSON :: PLogEnable -> Value
toJSON PLogEnable
_ = Value
A.Null
instance Command PLogEnable where
  type CommandResponse PLogEnable = ()
  commandName :: Proxy PLogEnable -> String
commandName Proxy PLogEnable
_ = String
"Log.enable"
  fromJSON :: Proxy PLogEnable -> Value -> Result (CommandResponse PLogEnable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PLogEnable -> Result ())
-> Proxy PLogEnable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PLogEnable -> ()) -> Proxy PLogEnable -> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PLogEnable -> ()
forall a b. a -> b -> a
const ()

-- | start violation reporting.

-- | Parameters of the 'Log.startViolationsReport' command.
data PLogStartViolationsReport = PLogStartViolationsReport
  {
    -- | Configuration for violations.
    PLogStartViolationsReport -> [LogViolationSetting]
pLogStartViolationsReportConfig :: [LogViolationSetting]
  }
  deriving (PLogStartViolationsReport -> PLogStartViolationsReport -> Bool
(PLogStartViolationsReport -> PLogStartViolationsReport -> Bool)
-> (PLogStartViolationsReport -> PLogStartViolationsReport -> Bool)
-> Eq PLogStartViolationsReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLogStartViolationsReport -> PLogStartViolationsReport -> Bool
$c/= :: PLogStartViolationsReport -> PLogStartViolationsReport -> Bool
== :: PLogStartViolationsReport -> PLogStartViolationsReport -> Bool
$c== :: PLogStartViolationsReport -> PLogStartViolationsReport -> Bool
Eq, Int -> PLogStartViolationsReport -> ShowS
[PLogStartViolationsReport] -> ShowS
PLogStartViolationsReport -> String
(Int -> PLogStartViolationsReport -> ShowS)
-> (PLogStartViolationsReport -> String)
-> ([PLogStartViolationsReport] -> ShowS)
-> Show PLogStartViolationsReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLogStartViolationsReport] -> ShowS
$cshowList :: [PLogStartViolationsReport] -> ShowS
show :: PLogStartViolationsReport -> String
$cshow :: PLogStartViolationsReport -> String
showsPrec :: Int -> PLogStartViolationsReport -> ShowS
$cshowsPrec :: Int -> PLogStartViolationsReport -> ShowS
Show)
pLogStartViolationsReport
  {-
  -- | Configuration for violations.
  -}
  :: [LogViolationSetting]
  -> PLogStartViolationsReport
pLogStartViolationsReport :: [LogViolationSetting] -> PLogStartViolationsReport
pLogStartViolationsReport
  [LogViolationSetting]
arg_pLogStartViolationsReportConfig
  = [LogViolationSetting] -> PLogStartViolationsReport
PLogStartViolationsReport
    [LogViolationSetting]
arg_pLogStartViolationsReportConfig
instance ToJSON PLogStartViolationsReport where
  toJSON :: PLogStartViolationsReport -> Value
toJSON PLogStartViolationsReport
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"config" Text -> [LogViolationSetting] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([LogViolationSetting] -> Pair)
-> Maybe [LogViolationSetting] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LogViolationSetting] -> Maybe [LogViolationSetting]
forall a. a -> Maybe a
Just (PLogStartViolationsReport -> [LogViolationSetting]
pLogStartViolationsReportConfig PLogStartViolationsReport
p)
    ]
instance Command PLogStartViolationsReport where
  type CommandResponse PLogStartViolationsReport = ()
  commandName :: Proxy PLogStartViolationsReport -> String
commandName Proxy PLogStartViolationsReport
_ = String
"Log.startViolationsReport"
  fromJSON :: Proxy PLogStartViolationsReport
-> Value -> Result (CommandResponse PLogStartViolationsReport)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PLogStartViolationsReport -> Result ())
-> Proxy PLogStartViolationsReport
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PLogStartViolationsReport -> ())
-> Proxy PLogStartViolationsReport
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PLogStartViolationsReport -> ()
forall a b. a -> b -> a
const ()

-- | Stop violation reporting.

-- | Parameters of the 'Log.stopViolationsReport' command.
data PLogStopViolationsReport = PLogStopViolationsReport
  deriving (PLogStopViolationsReport -> PLogStopViolationsReport -> Bool
(PLogStopViolationsReport -> PLogStopViolationsReport -> Bool)
-> (PLogStopViolationsReport -> PLogStopViolationsReport -> Bool)
-> Eq PLogStopViolationsReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLogStopViolationsReport -> PLogStopViolationsReport -> Bool
$c/= :: PLogStopViolationsReport -> PLogStopViolationsReport -> Bool
== :: PLogStopViolationsReport -> PLogStopViolationsReport -> Bool
$c== :: PLogStopViolationsReport -> PLogStopViolationsReport -> Bool
Eq, Int -> PLogStopViolationsReport -> ShowS
[PLogStopViolationsReport] -> ShowS
PLogStopViolationsReport -> String
(Int -> PLogStopViolationsReport -> ShowS)
-> (PLogStopViolationsReport -> String)
-> ([PLogStopViolationsReport] -> ShowS)
-> Show PLogStopViolationsReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLogStopViolationsReport] -> ShowS
$cshowList :: [PLogStopViolationsReport] -> ShowS
show :: PLogStopViolationsReport -> String
$cshow :: PLogStopViolationsReport -> String
showsPrec :: Int -> PLogStopViolationsReport -> ShowS
$cshowsPrec :: Int -> PLogStopViolationsReport -> ShowS
Show)
pLogStopViolationsReport
  :: PLogStopViolationsReport
pLogStopViolationsReport :: PLogStopViolationsReport
pLogStopViolationsReport
  = PLogStopViolationsReport
PLogStopViolationsReport
instance ToJSON PLogStopViolationsReport where
  toJSON :: PLogStopViolationsReport -> Value
toJSON PLogStopViolationsReport
_ = Value
A.Null
instance Command PLogStopViolationsReport where
  type CommandResponse PLogStopViolationsReport = ()
  commandName :: Proxy PLogStopViolationsReport -> String
commandName Proxy PLogStopViolationsReport
_ = String
"Log.stopViolationsReport"
  fromJSON :: Proxy PLogStopViolationsReport
-> Value -> Result (CommandResponse PLogStopViolationsReport)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PLogStopViolationsReport -> Result ())
-> Proxy PLogStopViolationsReport
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PLogStopViolationsReport -> ())
-> Proxy PLogStopViolationsReport
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PLogStopViolationsReport -> ()
forall a b. a -> b -> a
const ()