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


{- |
= Fetch

A domain for letting clients substitute browser's network layer with client code.
-}


module CDP.Domains.Fetch (module CDP.Domains.Fetch) 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.IO as IO


-- | Type 'Fetch.RequestId'.
--   Unique request identifier.
type FetchRequestId = T.Text

-- | Type 'Fetch.RequestStage'.
--   Stages of the request to handle. Request will intercept before the request is
--   sent. Response will intercept after the response is received (but before response
--   body is received).
data FetchRequestStage = FetchRequestStageRequest | FetchRequestStageResponse
  deriving (Eq FetchRequestStage
Eq FetchRequestStage
-> (FetchRequestStage -> FetchRequestStage -> Ordering)
-> (FetchRequestStage -> FetchRequestStage -> Bool)
-> (FetchRequestStage -> FetchRequestStage -> Bool)
-> (FetchRequestStage -> FetchRequestStage -> Bool)
-> (FetchRequestStage -> FetchRequestStage -> Bool)
-> (FetchRequestStage -> FetchRequestStage -> FetchRequestStage)
-> (FetchRequestStage -> FetchRequestStage -> FetchRequestStage)
-> Ord FetchRequestStage
FetchRequestStage -> FetchRequestStage -> Bool
FetchRequestStage -> FetchRequestStage -> Ordering
FetchRequestStage -> FetchRequestStage -> FetchRequestStage
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 :: FetchRequestStage -> FetchRequestStage -> FetchRequestStage
$cmin :: FetchRequestStage -> FetchRequestStage -> FetchRequestStage
max :: FetchRequestStage -> FetchRequestStage -> FetchRequestStage
$cmax :: FetchRequestStage -> FetchRequestStage -> FetchRequestStage
>= :: FetchRequestStage -> FetchRequestStage -> Bool
$c>= :: FetchRequestStage -> FetchRequestStage -> Bool
> :: FetchRequestStage -> FetchRequestStage -> Bool
$c> :: FetchRequestStage -> FetchRequestStage -> Bool
<= :: FetchRequestStage -> FetchRequestStage -> Bool
$c<= :: FetchRequestStage -> FetchRequestStage -> Bool
< :: FetchRequestStage -> FetchRequestStage -> Bool
$c< :: FetchRequestStage -> FetchRequestStage -> Bool
compare :: FetchRequestStage -> FetchRequestStage -> Ordering
$ccompare :: FetchRequestStage -> FetchRequestStage -> Ordering
$cp1Ord :: Eq FetchRequestStage
Ord, FetchRequestStage -> FetchRequestStage -> Bool
(FetchRequestStage -> FetchRequestStage -> Bool)
-> (FetchRequestStage -> FetchRequestStage -> Bool)
-> Eq FetchRequestStage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchRequestStage -> FetchRequestStage -> Bool
$c/= :: FetchRequestStage -> FetchRequestStage -> Bool
== :: FetchRequestStage -> FetchRequestStage -> Bool
$c== :: FetchRequestStage -> FetchRequestStage -> Bool
Eq, Int -> FetchRequestStage -> ShowS
[FetchRequestStage] -> ShowS
FetchRequestStage -> String
(Int -> FetchRequestStage -> ShowS)
-> (FetchRequestStage -> String)
-> ([FetchRequestStage] -> ShowS)
-> Show FetchRequestStage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchRequestStage] -> ShowS
$cshowList :: [FetchRequestStage] -> ShowS
show :: FetchRequestStage -> String
$cshow :: FetchRequestStage -> String
showsPrec :: Int -> FetchRequestStage -> ShowS
$cshowsPrec :: Int -> FetchRequestStage -> ShowS
Show, ReadPrec [FetchRequestStage]
ReadPrec FetchRequestStage
Int -> ReadS FetchRequestStage
ReadS [FetchRequestStage]
(Int -> ReadS FetchRequestStage)
-> ReadS [FetchRequestStage]
-> ReadPrec FetchRequestStage
-> ReadPrec [FetchRequestStage]
-> Read FetchRequestStage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FetchRequestStage]
$creadListPrec :: ReadPrec [FetchRequestStage]
readPrec :: ReadPrec FetchRequestStage
$creadPrec :: ReadPrec FetchRequestStage
readList :: ReadS [FetchRequestStage]
$creadList :: ReadS [FetchRequestStage]
readsPrec :: Int -> ReadS FetchRequestStage
$creadsPrec :: Int -> ReadS FetchRequestStage
Read)
instance FromJSON FetchRequestStage where
  parseJSON :: Value -> Parser FetchRequestStage
parseJSON = String
-> (Text -> Parser FetchRequestStage)
-> Value
-> Parser FetchRequestStage
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"FetchRequestStage" ((Text -> Parser FetchRequestStage)
 -> Value -> Parser FetchRequestStage)
-> (Text -> Parser FetchRequestStage)
-> Value
-> Parser FetchRequestStage
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"Request" -> FetchRequestStage -> Parser FetchRequestStage
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchRequestStage
FetchRequestStageRequest
    Text
"Response" -> FetchRequestStage -> Parser FetchRequestStage
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchRequestStage
FetchRequestStageResponse
    Text
"_" -> String -> Parser FetchRequestStage
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse FetchRequestStage"
instance ToJSON FetchRequestStage where
  toJSON :: FetchRequestStage -> Value
toJSON FetchRequestStage
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case FetchRequestStage
v of
    FetchRequestStage
FetchRequestStageRequest -> Text
"Request"
    FetchRequestStage
FetchRequestStageResponse -> Text
"Response"

-- | Type 'Fetch.RequestPattern'.
data FetchRequestPattern = FetchRequestPattern
  {
    -- | Wildcards (`'*'` -> zero or more, `'?'` -> exactly one) are allowed. Escape character is
    --   backslash. Omitting is equivalent to `"*"`.
    FetchRequestPattern -> Maybe Text
fetchRequestPatternUrlPattern :: Maybe T.Text,
    -- | If set, only requests for matching resource types will be intercepted.
    FetchRequestPattern -> Maybe NetworkResourceType
fetchRequestPatternResourceType :: Maybe DOMPageNetworkEmulationSecurity.NetworkResourceType,
    -- | Stage at which to begin intercepting requests. Default is Request.
    FetchRequestPattern -> Maybe FetchRequestStage
fetchRequestPatternRequestStage :: Maybe FetchRequestStage
  }
  deriving (FetchRequestPattern -> FetchRequestPattern -> Bool
(FetchRequestPattern -> FetchRequestPattern -> Bool)
-> (FetchRequestPattern -> FetchRequestPattern -> Bool)
-> Eq FetchRequestPattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchRequestPattern -> FetchRequestPattern -> Bool
$c/= :: FetchRequestPattern -> FetchRequestPattern -> Bool
== :: FetchRequestPattern -> FetchRequestPattern -> Bool
$c== :: FetchRequestPattern -> FetchRequestPattern -> Bool
Eq, Int -> FetchRequestPattern -> ShowS
[FetchRequestPattern] -> ShowS
FetchRequestPattern -> String
(Int -> FetchRequestPattern -> ShowS)
-> (FetchRequestPattern -> String)
-> ([FetchRequestPattern] -> ShowS)
-> Show FetchRequestPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchRequestPattern] -> ShowS
$cshowList :: [FetchRequestPattern] -> ShowS
show :: FetchRequestPattern -> String
$cshow :: FetchRequestPattern -> String
showsPrec :: Int -> FetchRequestPattern -> ShowS
$cshowsPrec :: Int -> FetchRequestPattern -> ShowS
Show)
instance FromJSON FetchRequestPattern where
  parseJSON :: Value -> Parser FetchRequestPattern
parseJSON = String
-> (Object -> Parser FetchRequestPattern)
-> Value
-> Parser FetchRequestPattern
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FetchRequestPattern" ((Object -> Parser FetchRequestPattern)
 -> Value -> Parser FetchRequestPattern)
-> (Object -> Parser FetchRequestPattern)
-> Value
-> Parser FetchRequestPattern
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text
-> Maybe NetworkResourceType
-> Maybe FetchRequestStage
-> FetchRequestPattern
FetchRequestPattern
    (Maybe Text
 -> Maybe NetworkResourceType
 -> Maybe FetchRequestStage
 -> FetchRequestPattern)
-> Parser (Maybe Text)
-> Parser
     (Maybe NetworkResourceType
      -> Maybe FetchRequestStage -> FetchRequestPattern)
forall (f :: * -> *) a b. Functor 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
"urlPattern"
    Parser
  (Maybe NetworkResourceType
   -> Maybe FetchRequestStage -> FetchRequestPattern)
-> Parser (Maybe NetworkResourceType)
-> Parser (Maybe FetchRequestStage -> FetchRequestPattern)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe NetworkResourceType)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"resourceType"
    Parser (Maybe FetchRequestStage -> FetchRequestPattern)
-> Parser (Maybe FetchRequestStage) -> Parser FetchRequestPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe FetchRequestStage)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"requestStage"
instance ToJSON FetchRequestPattern where
  toJSON :: FetchRequestPattern -> Value
toJSON FetchRequestPattern
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
"urlPattern" 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
<$> (FetchRequestPattern -> Maybe Text
fetchRequestPatternUrlPattern FetchRequestPattern
p),
    (Text
"resourceType" Text -> NetworkResourceType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (NetworkResourceType -> Pair)
-> Maybe NetworkResourceType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FetchRequestPattern -> Maybe NetworkResourceType
fetchRequestPatternResourceType FetchRequestPattern
p),
    (Text
"requestStage" Text -> FetchRequestStage -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (FetchRequestStage -> Pair)
-> Maybe FetchRequestStage -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FetchRequestPattern -> Maybe FetchRequestStage
fetchRequestPatternRequestStage FetchRequestPattern
p)
    ]

-- | Type 'Fetch.HeaderEntry'.
--   Response HTTP header entry
data FetchHeaderEntry = FetchHeaderEntry
  {
    FetchHeaderEntry -> Text
fetchHeaderEntryName :: T.Text,
    FetchHeaderEntry -> Text
fetchHeaderEntryValue :: T.Text
  }
  deriving (FetchHeaderEntry -> FetchHeaderEntry -> Bool
(FetchHeaderEntry -> FetchHeaderEntry -> Bool)
-> (FetchHeaderEntry -> FetchHeaderEntry -> Bool)
-> Eq FetchHeaderEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchHeaderEntry -> FetchHeaderEntry -> Bool
$c/= :: FetchHeaderEntry -> FetchHeaderEntry -> Bool
== :: FetchHeaderEntry -> FetchHeaderEntry -> Bool
$c== :: FetchHeaderEntry -> FetchHeaderEntry -> Bool
Eq, Int -> FetchHeaderEntry -> ShowS
[FetchHeaderEntry] -> ShowS
FetchHeaderEntry -> String
(Int -> FetchHeaderEntry -> ShowS)
-> (FetchHeaderEntry -> String)
-> ([FetchHeaderEntry] -> ShowS)
-> Show FetchHeaderEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchHeaderEntry] -> ShowS
$cshowList :: [FetchHeaderEntry] -> ShowS
show :: FetchHeaderEntry -> String
$cshow :: FetchHeaderEntry -> String
showsPrec :: Int -> FetchHeaderEntry -> ShowS
$cshowsPrec :: Int -> FetchHeaderEntry -> ShowS
Show)
instance FromJSON FetchHeaderEntry where
  parseJSON :: Value -> Parser FetchHeaderEntry
parseJSON = String
-> (Object -> Parser FetchHeaderEntry)
-> Value
-> Parser FetchHeaderEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FetchHeaderEntry" ((Object -> Parser FetchHeaderEntry)
 -> Value -> Parser FetchHeaderEntry)
-> (Object -> Parser FetchHeaderEntry)
-> Value
-> Parser FetchHeaderEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> FetchHeaderEntry
FetchHeaderEntry
    (Text -> Text -> FetchHeaderEntry)
-> Parser Text -> Parser (Text -> FetchHeaderEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser (Text -> FetchHeaderEntry)
-> Parser Text -> Parser FetchHeaderEntry
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
"value"
instance ToJSON FetchHeaderEntry where
  toJSON :: FetchHeaderEntry -> Value
toJSON FetchHeaderEntry
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 -> 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 (FetchHeaderEntry -> Text
fetchHeaderEntryName FetchHeaderEntry
p),
    (Text
"value" 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 (FetchHeaderEntry -> Text
fetchHeaderEntryValue FetchHeaderEntry
p)
    ]

-- | Type 'Fetch.AuthChallenge'.
--   Authorization challenge for HTTP status code 401 or 407.
data FetchAuthChallengeSource = FetchAuthChallengeSourceServer | FetchAuthChallengeSourceProxy
  deriving (Eq FetchAuthChallengeSource
Eq FetchAuthChallengeSource
-> (FetchAuthChallengeSource
    -> FetchAuthChallengeSource -> Ordering)
-> (FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool)
-> (FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool)
-> (FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool)
-> (FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool)
-> (FetchAuthChallengeSource
    -> FetchAuthChallengeSource -> FetchAuthChallengeSource)
-> (FetchAuthChallengeSource
    -> FetchAuthChallengeSource -> FetchAuthChallengeSource)
-> Ord FetchAuthChallengeSource
FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
FetchAuthChallengeSource -> FetchAuthChallengeSource -> Ordering
FetchAuthChallengeSource
-> FetchAuthChallengeSource -> FetchAuthChallengeSource
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 :: FetchAuthChallengeSource
-> FetchAuthChallengeSource -> FetchAuthChallengeSource
$cmin :: FetchAuthChallengeSource
-> FetchAuthChallengeSource -> FetchAuthChallengeSource
max :: FetchAuthChallengeSource
-> FetchAuthChallengeSource -> FetchAuthChallengeSource
$cmax :: FetchAuthChallengeSource
-> FetchAuthChallengeSource -> FetchAuthChallengeSource
>= :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
$c>= :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
> :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
$c> :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
<= :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
$c<= :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
< :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
$c< :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
compare :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Ordering
$ccompare :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Ordering
$cp1Ord :: Eq FetchAuthChallengeSource
Ord, FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
(FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool)
-> (FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool)
-> Eq FetchAuthChallengeSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
$c/= :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
== :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
$c== :: FetchAuthChallengeSource -> FetchAuthChallengeSource -> Bool
Eq, Int -> FetchAuthChallengeSource -> ShowS
[FetchAuthChallengeSource] -> ShowS
FetchAuthChallengeSource -> String
(Int -> FetchAuthChallengeSource -> ShowS)
-> (FetchAuthChallengeSource -> String)
-> ([FetchAuthChallengeSource] -> ShowS)
-> Show FetchAuthChallengeSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchAuthChallengeSource] -> ShowS
$cshowList :: [FetchAuthChallengeSource] -> ShowS
show :: FetchAuthChallengeSource -> String
$cshow :: FetchAuthChallengeSource -> String
showsPrec :: Int -> FetchAuthChallengeSource -> ShowS
$cshowsPrec :: Int -> FetchAuthChallengeSource -> ShowS
Show, ReadPrec [FetchAuthChallengeSource]
ReadPrec FetchAuthChallengeSource
Int -> ReadS FetchAuthChallengeSource
ReadS [FetchAuthChallengeSource]
(Int -> ReadS FetchAuthChallengeSource)
-> ReadS [FetchAuthChallengeSource]
-> ReadPrec FetchAuthChallengeSource
-> ReadPrec [FetchAuthChallengeSource]
-> Read FetchAuthChallengeSource
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FetchAuthChallengeSource]
$creadListPrec :: ReadPrec [FetchAuthChallengeSource]
readPrec :: ReadPrec FetchAuthChallengeSource
$creadPrec :: ReadPrec FetchAuthChallengeSource
readList :: ReadS [FetchAuthChallengeSource]
$creadList :: ReadS [FetchAuthChallengeSource]
readsPrec :: Int -> ReadS FetchAuthChallengeSource
$creadsPrec :: Int -> ReadS FetchAuthChallengeSource
Read)
instance FromJSON FetchAuthChallengeSource where
  parseJSON :: Value -> Parser FetchAuthChallengeSource
parseJSON = String
-> (Text -> Parser FetchAuthChallengeSource)
-> Value
-> Parser FetchAuthChallengeSource
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"FetchAuthChallengeSource" ((Text -> Parser FetchAuthChallengeSource)
 -> Value -> Parser FetchAuthChallengeSource)
-> (Text -> Parser FetchAuthChallengeSource)
-> Value
-> Parser FetchAuthChallengeSource
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"Server" -> FetchAuthChallengeSource -> Parser FetchAuthChallengeSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchAuthChallengeSource
FetchAuthChallengeSourceServer
    Text
"Proxy" -> FetchAuthChallengeSource -> Parser FetchAuthChallengeSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchAuthChallengeSource
FetchAuthChallengeSourceProxy
    Text
"_" -> String -> Parser FetchAuthChallengeSource
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse FetchAuthChallengeSource"
instance ToJSON FetchAuthChallengeSource where
  toJSON :: FetchAuthChallengeSource -> Value
toJSON FetchAuthChallengeSource
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case FetchAuthChallengeSource
v of
    FetchAuthChallengeSource
FetchAuthChallengeSourceServer -> Text
"Server"
    FetchAuthChallengeSource
FetchAuthChallengeSourceProxy -> Text
"Proxy"
data FetchAuthChallenge = FetchAuthChallenge
  {
    -- | Source of the authentication challenge.
    FetchAuthChallenge -> Maybe FetchAuthChallengeSource
fetchAuthChallengeSource :: Maybe FetchAuthChallengeSource,
    -- | Origin of the challenger.
    FetchAuthChallenge -> Text
fetchAuthChallengeOrigin :: T.Text,
    -- | The authentication scheme used, such as basic or digest
    FetchAuthChallenge -> Text
fetchAuthChallengeScheme :: T.Text,
    -- | The realm of the challenge. May be empty.
    FetchAuthChallenge -> Text
fetchAuthChallengeRealm :: T.Text
  }
  deriving (FetchAuthChallenge -> FetchAuthChallenge -> Bool
(FetchAuthChallenge -> FetchAuthChallenge -> Bool)
-> (FetchAuthChallenge -> FetchAuthChallenge -> Bool)
-> Eq FetchAuthChallenge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchAuthChallenge -> FetchAuthChallenge -> Bool
$c/= :: FetchAuthChallenge -> FetchAuthChallenge -> Bool
== :: FetchAuthChallenge -> FetchAuthChallenge -> Bool
$c== :: FetchAuthChallenge -> FetchAuthChallenge -> Bool
Eq, Int -> FetchAuthChallenge -> ShowS
[FetchAuthChallenge] -> ShowS
FetchAuthChallenge -> String
(Int -> FetchAuthChallenge -> ShowS)
-> (FetchAuthChallenge -> String)
-> ([FetchAuthChallenge] -> ShowS)
-> Show FetchAuthChallenge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchAuthChallenge] -> ShowS
$cshowList :: [FetchAuthChallenge] -> ShowS
show :: FetchAuthChallenge -> String
$cshow :: FetchAuthChallenge -> String
showsPrec :: Int -> FetchAuthChallenge -> ShowS
$cshowsPrec :: Int -> FetchAuthChallenge -> ShowS
Show)
instance FromJSON FetchAuthChallenge where
  parseJSON :: Value -> Parser FetchAuthChallenge
parseJSON = String
-> (Object -> Parser FetchAuthChallenge)
-> Value
-> Parser FetchAuthChallenge
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FetchAuthChallenge" ((Object -> Parser FetchAuthChallenge)
 -> Value -> Parser FetchAuthChallenge)
-> (Object -> Parser FetchAuthChallenge)
-> Value
-> Parser FetchAuthChallenge
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe FetchAuthChallengeSource
-> Text -> Text -> Text -> FetchAuthChallenge
FetchAuthChallenge
    (Maybe FetchAuthChallengeSource
 -> Text -> Text -> Text -> FetchAuthChallenge)
-> Parser (Maybe FetchAuthChallengeSource)
-> Parser (Text -> Text -> Text -> FetchAuthChallenge)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe FetchAuthChallengeSource)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"source"
    Parser (Text -> Text -> Text -> FetchAuthChallenge)
-> Parser Text -> Parser (Text -> Text -> FetchAuthChallenge)
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
"origin"
    Parser (Text -> Text -> FetchAuthChallenge)
-> Parser Text -> Parser (Text -> FetchAuthChallenge)
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
"scheme"
    Parser (Text -> FetchAuthChallenge)
-> Parser Text -> Parser FetchAuthChallenge
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
"realm"
instance ToJSON FetchAuthChallenge where
  toJSON :: FetchAuthChallenge -> Value
toJSON FetchAuthChallenge
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 -> FetchAuthChallengeSource -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (FetchAuthChallengeSource -> Pair)
-> Maybe FetchAuthChallengeSource -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FetchAuthChallenge -> Maybe FetchAuthChallengeSource
fetchAuthChallengeSource FetchAuthChallenge
p),
    (Text
"origin" 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 (FetchAuthChallenge -> Text
fetchAuthChallengeOrigin FetchAuthChallenge
p),
    (Text
"scheme" 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 (FetchAuthChallenge -> Text
fetchAuthChallengeScheme FetchAuthChallenge
p),
    (Text
"realm" 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 (FetchAuthChallenge -> Text
fetchAuthChallengeRealm FetchAuthChallenge
p)
    ]

-- | Type 'Fetch.AuthChallengeResponse'.
--   Response to an AuthChallenge.
data FetchAuthChallengeResponseResponse = FetchAuthChallengeResponseResponseDefault | FetchAuthChallengeResponseResponseCancelAuth | FetchAuthChallengeResponseResponseProvideCredentials
  deriving (Eq FetchAuthChallengeResponseResponse
Eq FetchAuthChallengeResponseResponse
-> (FetchAuthChallengeResponseResponse
    -> FetchAuthChallengeResponseResponse -> Ordering)
-> (FetchAuthChallengeResponseResponse
    -> FetchAuthChallengeResponseResponse -> Bool)
-> (FetchAuthChallengeResponseResponse
    -> FetchAuthChallengeResponseResponse -> Bool)
-> (FetchAuthChallengeResponseResponse
    -> FetchAuthChallengeResponseResponse -> Bool)
-> (FetchAuthChallengeResponseResponse
    -> FetchAuthChallengeResponseResponse -> Bool)
-> (FetchAuthChallengeResponseResponse
    -> FetchAuthChallengeResponseResponse
    -> FetchAuthChallengeResponseResponse)
-> (FetchAuthChallengeResponseResponse
    -> FetchAuthChallengeResponseResponse
    -> FetchAuthChallengeResponseResponse)
-> Ord FetchAuthChallengeResponseResponse
FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Ordering
FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse
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 :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse
$cmin :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse
max :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse
$cmax :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse
>= :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
$c>= :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
> :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
$c> :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
<= :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
$c<= :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
< :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
$c< :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
compare :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Ordering
$ccompare :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Ordering
$cp1Ord :: Eq FetchAuthChallengeResponseResponse
Ord, FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
(FetchAuthChallengeResponseResponse
 -> FetchAuthChallengeResponseResponse -> Bool)
-> (FetchAuthChallengeResponseResponse
    -> FetchAuthChallengeResponseResponse -> Bool)
-> Eq FetchAuthChallengeResponseResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
$c/= :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
== :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
$c== :: FetchAuthChallengeResponseResponse
-> FetchAuthChallengeResponseResponse -> Bool
Eq, Int -> FetchAuthChallengeResponseResponse -> ShowS
[FetchAuthChallengeResponseResponse] -> ShowS
FetchAuthChallengeResponseResponse -> String
(Int -> FetchAuthChallengeResponseResponse -> ShowS)
-> (FetchAuthChallengeResponseResponse -> String)
-> ([FetchAuthChallengeResponseResponse] -> ShowS)
-> Show FetchAuthChallengeResponseResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchAuthChallengeResponseResponse] -> ShowS
$cshowList :: [FetchAuthChallengeResponseResponse] -> ShowS
show :: FetchAuthChallengeResponseResponse -> String
$cshow :: FetchAuthChallengeResponseResponse -> String
showsPrec :: Int -> FetchAuthChallengeResponseResponse -> ShowS
$cshowsPrec :: Int -> FetchAuthChallengeResponseResponse -> ShowS
Show, ReadPrec [FetchAuthChallengeResponseResponse]
ReadPrec FetchAuthChallengeResponseResponse
Int -> ReadS FetchAuthChallengeResponseResponse
ReadS [FetchAuthChallengeResponseResponse]
(Int -> ReadS FetchAuthChallengeResponseResponse)
-> ReadS [FetchAuthChallengeResponseResponse]
-> ReadPrec FetchAuthChallengeResponseResponse
-> ReadPrec [FetchAuthChallengeResponseResponse]
-> Read FetchAuthChallengeResponseResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FetchAuthChallengeResponseResponse]
$creadListPrec :: ReadPrec [FetchAuthChallengeResponseResponse]
readPrec :: ReadPrec FetchAuthChallengeResponseResponse
$creadPrec :: ReadPrec FetchAuthChallengeResponseResponse
readList :: ReadS [FetchAuthChallengeResponseResponse]
$creadList :: ReadS [FetchAuthChallengeResponseResponse]
readsPrec :: Int -> ReadS FetchAuthChallengeResponseResponse
$creadsPrec :: Int -> ReadS FetchAuthChallengeResponseResponse
Read)
instance FromJSON FetchAuthChallengeResponseResponse where
  parseJSON :: Value -> Parser FetchAuthChallengeResponseResponse
parseJSON = String
-> (Text -> Parser FetchAuthChallengeResponseResponse)
-> Value
-> Parser FetchAuthChallengeResponseResponse
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"FetchAuthChallengeResponseResponse" ((Text -> Parser FetchAuthChallengeResponseResponse)
 -> Value -> Parser FetchAuthChallengeResponseResponse)
-> (Text -> Parser FetchAuthChallengeResponseResponse)
-> Value
-> Parser FetchAuthChallengeResponseResponse
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"Default" -> FetchAuthChallengeResponseResponse
-> Parser FetchAuthChallengeResponseResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchAuthChallengeResponseResponse
FetchAuthChallengeResponseResponseDefault
    Text
"CancelAuth" -> FetchAuthChallengeResponseResponse
-> Parser FetchAuthChallengeResponseResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchAuthChallengeResponseResponse
FetchAuthChallengeResponseResponseCancelAuth
    Text
"ProvideCredentials" -> FetchAuthChallengeResponseResponse
-> Parser FetchAuthChallengeResponseResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchAuthChallengeResponseResponse
FetchAuthChallengeResponseResponseProvideCredentials
    Text
"_" -> String -> Parser FetchAuthChallengeResponseResponse
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse FetchAuthChallengeResponseResponse"
instance ToJSON FetchAuthChallengeResponseResponse where
  toJSON :: FetchAuthChallengeResponseResponse -> Value
toJSON FetchAuthChallengeResponseResponse
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case FetchAuthChallengeResponseResponse
v of
    FetchAuthChallengeResponseResponse
FetchAuthChallengeResponseResponseDefault -> Text
"Default"
    FetchAuthChallengeResponseResponse
FetchAuthChallengeResponseResponseCancelAuth -> Text
"CancelAuth"
    FetchAuthChallengeResponseResponse
FetchAuthChallengeResponseResponseProvideCredentials -> Text
"ProvideCredentials"
data FetchAuthChallengeResponse = FetchAuthChallengeResponse
  {
    -- | The decision on what to do in response to the authorization challenge.  Default means
    --   deferring to the default behavior of the net stack, which will likely either the Cancel
    --   authentication or display a popup dialog box.
    FetchAuthChallengeResponse -> FetchAuthChallengeResponseResponse
fetchAuthChallengeResponseResponse :: FetchAuthChallengeResponseResponse,
    -- | The username to provide, possibly empty. Should only be set if response is
    --   ProvideCredentials.
    FetchAuthChallengeResponse -> Maybe Text
fetchAuthChallengeResponseUsername :: Maybe T.Text,
    -- | The password to provide, possibly empty. Should only be set if response is
    --   ProvideCredentials.
    FetchAuthChallengeResponse -> Maybe Text
fetchAuthChallengeResponsePassword :: Maybe T.Text
  }
  deriving (FetchAuthChallengeResponse -> FetchAuthChallengeResponse -> Bool
(FetchAuthChallengeResponse -> FetchAuthChallengeResponse -> Bool)
-> (FetchAuthChallengeResponse
    -> FetchAuthChallengeResponse -> Bool)
-> Eq FetchAuthChallengeResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchAuthChallengeResponse -> FetchAuthChallengeResponse -> Bool
$c/= :: FetchAuthChallengeResponse -> FetchAuthChallengeResponse -> Bool
== :: FetchAuthChallengeResponse -> FetchAuthChallengeResponse -> Bool
$c== :: FetchAuthChallengeResponse -> FetchAuthChallengeResponse -> Bool
Eq, Int -> FetchAuthChallengeResponse -> ShowS
[FetchAuthChallengeResponse] -> ShowS
FetchAuthChallengeResponse -> String
(Int -> FetchAuthChallengeResponse -> ShowS)
-> (FetchAuthChallengeResponse -> String)
-> ([FetchAuthChallengeResponse] -> ShowS)
-> Show FetchAuthChallengeResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchAuthChallengeResponse] -> ShowS
$cshowList :: [FetchAuthChallengeResponse] -> ShowS
show :: FetchAuthChallengeResponse -> String
$cshow :: FetchAuthChallengeResponse -> String
showsPrec :: Int -> FetchAuthChallengeResponse -> ShowS
$cshowsPrec :: Int -> FetchAuthChallengeResponse -> ShowS
Show)
instance FromJSON FetchAuthChallengeResponse where
  parseJSON :: Value -> Parser FetchAuthChallengeResponse
parseJSON = String
-> (Object -> Parser FetchAuthChallengeResponse)
-> Value
-> Parser FetchAuthChallengeResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FetchAuthChallengeResponse" ((Object -> Parser FetchAuthChallengeResponse)
 -> Value -> Parser FetchAuthChallengeResponse)
-> (Object -> Parser FetchAuthChallengeResponse)
-> Value
-> Parser FetchAuthChallengeResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> FetchAuthChallengeResponseResponse
-> Maybe Text -> Maybe Text -> FetchAuthChallengeResponse
FetchAuthChallengeResponse
    (FetchAuthChallengeResponseResponse
 -> Maybe Text -> Maybe Text -> FetchAuthChallengeResponse)
-> Parser FetchAuthChallengeResponseResponse
-> Parser (Maybe Text -> Maybe Text -> FetchAuthChallengeResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser FetchAuthChallengeResponseResponse
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"response"
    Parser (Maybe Text -> Maybe Text -> FetchAuthChallengeResponse)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> FetchAuthChallengeResponse)
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
"username"
    Parser (Maybe Text -> FetchAuthChallengeResponse)
-> Parser (Maybe Text) -> Parser FetchAuthChallengeResponse
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
"password"
instance ToJSON FetchAuthChallengeResponse where
  toJSON :: FetchAuthChallengeResponse -> Value
toJSON FetchAuthChallengeResponse
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
"response" Text -> FetchAuthChallengeResponseResponse -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (FetchAuthChallengeResponseResponse -> Pair)
-> Maybe FetchAuthChallengeResponseResponse -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FetchAuthChallengeResponseResponse
-> Maybe FetchAuthChallengeResponseResponse
forall a. a -> Maybe a
Just (FetchAuthChallengeResponse -> FetchAuthChallengeResponseResponse
fetchAuthChallengeResponseResponse FetchAuthChallengeResponse
p),
    (Text
"username" 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
<$> (FetchAuthChallengeResponse -> Maybe Text
fetchAuthChallengeResponseUsername FetchAuthChallengeResponse
p),
    (Text
"password" 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
<$> (FetchAuthChallengeResponse -> Maybe Text
fetchAuthChallengeResponsePassword FetchAuthChallengeResponse
p)
    ]

-- | Type of the 'Fetch.requestPaused' event.
data FetchRequestPaused = FetchRequestPaused
  {
    -- | Each request the page makes will have a unique id.
    FetchRequestPaused -> Text
fetchRequestPausedRequestId :: FetchRequestId,
    -- | The details of the request.
    FetchRequestPaused -> NetworkRequest
fetchRequestPausedRequest :: DOMPageNetworkEmulationSecurity.NetworkRequest,
    -- | The id of the frame that initiated the request.
    FetchRequestPaused -> Text
fetchRequestPausedFrameId :: DOMPageNetworkEmulationSecurity.PageFrameId,
    -- | How the requested resource will be used.
    FetchRequestPaused -> NetworkResourceType
fetchRequestPausedResourceType :: DOMPageNetworkEmulationSecurity.NetworkResourceType,
    -- | Response error if intercepted at response stage.
    FetchRequestPaused -> Maybe NetworkErrorReason
fetchRequestPausedResponseErrorReason :: Maybe DOMPageNetworkEmulationSecurity.NetworkErrorReason,
    -- | Response code if intercepted at response stage.
    FetchRequestPaused -> Maybe Int
fetchRequestPausedResponseStatusCode :: Maybe Int,
    -- | Response status text if intercepted at response stage.
    FetchRequestPaused -> Maybe Text
fetchRequestPausedResponseStatusText :: Maybe T.Text,
    -- | Response headers if intercepted at the response stage.
    FetchRequestPaused -> Maybe [FetchHeaderEntry]
fetchRequestPausedResponseHeaders :: Maybe [FetchHeaderEntry],
    -- | If the intercepted request had a corresponding Network.requestWillBeSent event fired for it,
    --   then this networkId will be the same as the requestId present in the requestWillBeSent event.
    FetchRequestPaused -> Maybe Text
fetchRequestPausedNetworkId :: Maybe DOMPageNetworkEmulationSecurity.NetworkRequestId,
    -- | If the request is due to a redirect response from the server, the id of the request that
    --   has caused the redirect.
    FetchRequestPaused -> Maybe Text
fetchRequestPausedRedirectedRequestId :: Maybe FetchRequestId
  }
  deriving (FetchRequestPaused -> FetchRequestPaused -> Bool
(FetchRequestPaused -> FetchRequestPaused -> Bool)
-> (FetchRequestPaused -> FetchRequestPaused -> Bool)
-> Eq FetchRequestPaused
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchRequestPaused -> FetchRequestPaused -> Bool
$c/= :: FetchRequestPaused -> FetchRequestPaused -> Bool
== :: FetchRequestPaused -> FetchRequestPaused -> Bool
$c== :: FetchRequestPaused -> FetchRequestPaused -> Bool
Eq, Int -> FetchRequestPaused -> ShowS
[FetchRequestPaused] -> ShowS
FetchRequestPaused -> String
(Int -> FetchRequestPaused -> ShowS)
-> (FetchRequestPaused -> String)
-> ([FetchRequestPaused] -> ShowS)
-> Show FetchRequestPaused
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchRequestPaused] -> ShowS
$cshowList :: [FetchRequestPaused] -> ShowS
show :: FetchRequestPaused -> String
$cshow :: FetchRequestPaused -> String
showsPrec :: Int -> FetchRequestPaused -> ShowS
$cshowsPrec :: Int -> FetchRequestPaused -> ShowS
Show)
instance FromJSON FetchRequestPaused where
  parseJSON :: Value -> Parser FetchRequestPaused
parseJSON = String
-> (Object -> Parser FetchRequestPaused)
-> Value
-> Parser FetchRequestPaused
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FetchRequestPaused" ((Object -> Parser FetchRequestPaused)
 -> Value -> Parser FetchRequestPaused)
-> (Object -> Parser FetchRequestPaused)
-> Value
-> Parser FetchRequestPaused
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> NetworkRequest
-> Text
-> NetworkResourceType
-> Maybe NetworkErrorReason
-> Maybe Int
-> Maybe Text
-> Maybe [FetchHeaderEntry]
-> Maybe Text
-> Maybe Text
-> FetchRequestPaused
FetchRequestPaused
    (Text
 -> NetworkRequest
 -> Text
 -> NetworkResourceType
 -> Maybe NetworkErrorReason
 -> Maybe Int
 -> Maybe Text
 -> Maybe [FetchHeaderEntry]
 -> Maybe Text
 -> Maybe Text
 -> FetchRequestPaused)
-> Parser Text
-> Parser
     (NetworkRequest
      -> Text
      -> NetworkResourceType
      -> Maybe NetworkErrorReason
      -> Maybe Int
      -> Maybe Text
      -> Maybe [FetchHeaderEntry]
      -> Maybe Text
      -> Maybe Text
      -> FetchRequestPaused)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"requestId"
    Parser
  (NetworkRequest
   -> Text
   -> NetworkResourceType
   -> Maybe NetworkErrorReason
   -> Maybe Int
   -> Maybe Text
   -> Maybe [FetchHeaderEntry]
   -> Maybe Text
   -> Maybe Text
   -> FetchRequestPaused)
-> Parser NetworkRequest
-> Parser
     (Text
      -> NetworkResourceType
      -> Maybe NetworkErrorReason
      -> Maybe Int
      -> Maybe Text
      -> Maybe [FetchHeaderEntry]
      -> Maybe Text
      -> Maybe Text
      -> FetchRequestPaused)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser NetworkRequest
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"request"
    Parser
  (Text
   -> NetworkResourceType
   -> Maybe NetworkErrorReason
   -> Maybe Int
   -> Maybe Text
   -> Maybe [FetchHeaderEntry]
   -> Maybe Text
   -> Maybe Text
   -> FetchRequestPaused)
-> Parser Text
-> Parser
     (NetworkResourceType
      -> Maybe NetworkErrorReason
      -> Maybe Int
      -> Maybe Text
      -> Maybe [FetchHeaderEntry]
      -> Maybe Text
      -> Maybe Text
      -> FetchRequestPaused)
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
"frameId"
    Parser
  (NetworkResourceType
   -> Maybe NetworkErrorReason
   -> Maybe Int
   -> Maybe Text
   -> Maybe [FetchHeaderEntry]
   -> Maybe Text
   -> Maybe Text
   -> FetchRequestPaused)
-> Parser NetworkResourceType
-> Parser
     (Maybe NetworkErrorReason
      -> Maybe Int
      -> Maybe Text
      -> Maybe [FetchHeaderEntry]
      -> Maybe Text
      -> Maybe Text
      -> FetchRequestPaused)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser NetworkResourceType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"resourceType"
    Parser
  (Maybe NetworkErrorReason
   -> Maybe Int
   -> Maybe Text
   -> Maybe [FetchHeaderEntry]
   -> Maybe Text
   -> Maybe Text
   -> FetchRequestPaused)
-> Parser (Maybe NetworkErrorReason)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe [FetchHeaderEntry]
      -> Maybe Text
      -> Maybe Text
      -> FetchRequestPaused)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe NetworkErrorReason)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"responseErrorReason"
    Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe [FetchHeaderEntry]
   -> Maybe Text
   -> Maybe Text
   -> FetchRequestPaused)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe [FetchHeaderEntry]
      -> Maybe Text
      -> Maybe Text
      -> FetchRequestPaused)
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
"responseStatusCode"
    Parser
  (Maybe Text
   -> Maybe [FetchHeaderEntry]
   -> Maybe Text
   -> Maybe Text
   -> FetchRequestPaused)
-> Parser (Maybe Text)
-> Parser
     (Maybe [FetchHeaderEntry]
      -> Maybe Text -> Maybe Text -> FetchRequestPaused)
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
"responseStatusText"
    Parser
  (Maybe [FetchHeaderEntry]
   -> Maybe Text -> Maybe Text -> FetchRequestPaused)
-> Parser (Maybe [FetchHeaderEntry])
-> Parser (Maybe Text -> Maybe Text -> FetchRequestPaused)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [FetchHeaderEntry])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"responseHeaders"
    Parser (Maybe Text -> Maybe Text -> FetchRequestPaused)
-> Parser (Maybe Text) -> Parser (Maybe Text -> FetchRequestPaused)
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
"networkId"
    Parser (Maybe Text -> FetchRequestPaused)
-> Parser (Maybe Text) -> Parser FetchRequestPaused
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
"redirectedRequestId"
instance Event FetchRequestPaused where
  eventName :: Proxy FetchRequestPaused -> String
eventName Proxy FetchRequestPaused
_ = String
"Fetch.requestPaused"

-- | Type of the 'Fetch.authRequired' event.
data FetchAuthRequired = FetchAuthRequired
  {
    -- | Each request the page makes will have a unique id.
    FetchAuthRequired -> Text
fetchAuthRequiredRequestId :: FetchRequestId,
    -- | The details of the request.
    FetchAuthRequired -> NetworkRequest
fetchAuthRequiredRequest :: DOMPageNetworkEmulationSecurity.NetworkRequest,
    -- | The id of the frame that initiated the request.
    FetchAuthRequired -> Text
fetchAuthRequiredFrameId :: DOMPageNetworkEmulationSecurity.PageFrameId,
    -- | How the requested resource will be used.
    FetchAuthRequired -> NetworkResourceType
fetchAuthRequiredResourceType :: DOMPageNetworkEmulationSecurity.NetworkResourceType,
    -- | Details of the Authorization Challenge encountered.
    --   If this is set, client should respond with continueRequest that
    --   contains AuthChallengeResponse.
    FetchAuthRequired -> FetchAuthChallenge
fetchAuthRequiredAuthChallenge :: FetchAuthChallenge
  }
  deriving (FetchAuthRequired -> FetchAuthRequired -> Bool
(FetchAuthRequired -> FetchAuthRequired -> Bool)
-> (FetchAuthRequired -> FetchAuthRequired -> Bool)
-> Eq FetchAuthRequired
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchAuthRequired -> FetchAuthRequired -> Bool
$c/= :: FetchAuthRequired -> FetchAuthRequired -> Bool
== :: FetchAuthRequired -> FetchAuthRequired -> Bool
$c== :: FetchAuthRequired -> FetchAuthRequired -> Bool
Eq, Int -> FetchAuthRequired -> ShowS
[FetchAuthRequired] -> ShowS
FetchAuthRequired -> String
(Int -> FetchAuthRequired -> ShowS)
-> (FetchAuthRequired -> String)
-> ([FetchAuthRequired] -> ShowS)
-> Show FetchAuthRequired
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchAuthRequired] -> ShowS
$cshowList :: [FetchAuthRequired] -> ShowS
show :: FetchAuthRequired -> String
$cshow :: FetchAuthRequired -> String
showsPrec :: Int -> FetchAuthRequired -> ShowS
$cshowsPrec :: Int -> FetchAuthRequired -> ShowS
Show)
instance FromJSON FetchAuthRequired where
  parseJSON :: Value -> Parser FetchAuthRequired
parseJSON = String
-> (Object -> Parser FetchAuthRequired)
-> Value
-> Parser FetchAuthRequired
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FetchAuthRequired" ((Object -> Parser FetchAuthRequired)
 -> Value -> Parser FetchAuthRequired)
-> (Object -> Parser FetchAuthRequired)
-> Value
-> Parser FetchAuthRequired
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> NetworkRequest
-> Text
-> NetworkResourceType
-> FetchAuthChallenge
-> FetchAuthRequired
FetchAuthRequired
    (Text
 -> NetworkRequest
 -> Text
 -> NetworkResourceType
 -> FetchAuthChallenge
 -> FetchAuthRequired)
-> Parser Text
-> Parser
     (NetworkRequest
      -> Text
      -> NetworkResourceType
      -> FetchAuthChallenge
      -> FetchAuthRequired)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"requestId"
    Parser
  (NetworkRequest
   -> Text
   -> NetworkResourceType
   -> FetchAuthChallenge
   -> FetchAuthRequired)
-> Parser NetworkRequest
-> Parser
     (Text
      -> NetworkResourceType -> FetchAuthChallenge -> FetchAuthRequired)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser NetworkRequest
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"request"
    Parser
  (Text
   -> NetworkResourceType -> FetchAuthChallenge -> FetchAuthRequired)
-> Parser Text
-> Parser
     (NetworkResourceType -> FetchAuthChallenge -> FetchAuthRequired)
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
"frameId"
    Parser
  (NetworkResourceType -> FetchAuthChallenge -> FetchAuthRequired)
-> Parser NetworkResourceType
-> Parser (FetchAuthChallenge -> FetchAuthRequired)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser NetworkResourceType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"resourceType"
    Parser (FetchAuthChallenge -> FetchAuthRequired)
-> Parser FetchAuthChallenge -> Parser FetchAuthRequired
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser FetchAuthChallenge
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"authChallenge"
instance Event FetchAuthRequired where
  eventName :: Proxy FetchAuthRequired -> String
eventName Proxy FetchAuthRequired
_ = String
"Fetch.authRequired"

-- | Disables the fetch domain.

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

-- | Enables issuing of requestPaused events. A request will be paused until client
--   calls one of failRequest, fulfillRequest or continueRequest/continueWithAuth.

-- | Parameters of the 'Fetch.enable' command.
data PFetchEnable = PFetchEnable
  {
    -- | If specified, only requests matching any of these patterns will produce
    --   fetchRequested event and will be paused until clients response. If not set,
    --   all requests will be affected.
    PFetchEnable -> Maybe [FetchRequestPattern]
pFetchEnablePatterns :: Maybe [FetchRequestPattern],
    -- | If true, authRequired events will be issued and requests will be paused
    --   expecting a call to continueWithAuth.
    PFetchEnable -> Maybe Bool
pFetchEnableHandleAuthRequests :: Maybe Bool
  }
  deriving (PFetchEnable -> PFetchEnable -> Bool
(PFetchEnable -> PFetchEnable -> Bool)
-> (PFetchEnable -> PFetchEnable -> Bool) -> Eq PFetchEnable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFetchEnable -> PFetchEnable -> Bool
$c/= :: PFetchEnable -> PFetchEnable -> Bool
== :: PFetchEnable -> PFetchEnable -> Bool
$c== :: PFetchEnable -> PFetchEnable -> Bool
Eq, Int -> PFetchEnable -> ShowS
[PFetchEnable] -> ShowS
PFetchEnable -> String
(Int -> PFetchEnable -> ShowS)
-> (PFetchEnable -> String)
-> ([PFetchEnable] -> ShowS)
-> Show PFetchEnable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFetchEnable] -> ShowS
$cshowList :: [PFetchEnable] -> ShowS
show :: PFetchEnable -> String
$cshow :: PFetchEnable -> String
showsPrec :: Int -> PFetchEnable -> ShowS
$cshowsPrec :: Int -> PFetchEnable -> ShowS
Show)
pFetchEnable
  :: PFetchEnable
pFetchEnable :: PFetchEnable
pFetchEnable
  = Maybe [FetchRequestPattern] -> Maybe Bool -> PFetchEnable
PFetchEnable
    Maybe [FetchRequestPattern]
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PFetchEnable where
  toJSON :: PFetchEnable -> Value
toJSON PFetchEnable
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
"patterns" Text -> [FetchRequestPattern] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([FetchRequestPattern] -> Pair)
-> Maybe [FetchRequestPattern] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PFetchEnable -> Maybe [FetchRequestPattern]
pFetchEnablePatterns PFetchEnable
p),
    (Text
"handleAuthRequests" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PFetchEnable -> Maybe Bool
pFetchEnableHandleAuthRequests PFetchEnable
p)
    ]
instance Command PFetchEnable where
  type CommandResponse PFetchEnable = ()
  commandName :: Proxy PFetchEnable -> String
commandName Proxy PFetchEnable
_ = String
"Fetch.enable"
  fromJSON :: Proxy PFetchEnable
-> Value -> Result (CommandResponse PFetchEnable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PFetchEnable -> Result ())
-> Proxy PFetchEnable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PFetchEnable -> ()) -> Proxy PFetchEnable -> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PFetchEnable -> ()
forall a b. a -> b -> a
const ()

-- | Causes the request to fail with specified reason.

-- | Parameters of the 'Fetch.failRequest' command.
data PFetchFailRequest = PFetchFailRequest
  {
    -- | An id the client received in requestPaused event.
    PFetchFailRequest -> Text
pFetchFailRequestRequestId :: FetchRequestId,
    -- | Causes the request to fail with the given reason.
    PFetchFailRequest -> NetworkErrorReason
pFetchFailRequestErrorReason :: DOMPageNetworkEmulationSecurity.NetworkErrorReason
  }
  deriving (PFetchFailRequest -> PFetchFailRequest -> Bool
(PFetchFailRequest -> PFetchFailRequest -> Bool)
-> (PFetchFailRequest -> PFetchFailRequest -> Bool)
-> Eq PFetchFailRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFetchFailRequest -> PFetchFailRequest -> Bool
$c/= :: PFetchFailRequest -> PFetchFailRequest -> Bool
== :: PFetchFailRequest -> PFetchFailRequest -> Bool
$c== :: PFetchFailRequest -> PFetchFailRequest -> Bool
Eq, Int -> PFetchFailRequest -> ShowS
[PFetchFailRequest] -> ShowS
PFetchFailRequest -> String
(Int -> PFetchFailRequest -> ShowS)
-> (PFetchFailRequest -> String)
-> ([PFetchFailRequest] -> ShowS)
-> Show PFetchFailRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFetchFailRequest] -> ShowS
$cshowList :: [PFetchFailRequest] -> ShowS
show :: PFetchFailRequest -> String
$cshow :: PFetchFailRequest -> String
showsPrec :: Int -> PFetchFailRequest -> ShowS
$cshowsPrec :: Int -> PFetchFailRequest -> ShowS
Show)
pFetchFailRequest
  {-
  -- | An id the client received in requestPaused event.
  -}
  :: FetchRequestId
  {-
  -- | Causes the request to fail with the given reason.
  -}
  -> DOMPageNetworkEmulationSecurity.NetworkErrorReason
  -> PFetchFailRequest
pFetchFailRequest :: Text -> NetworkErrorReason -> PFetchFailRequest
pFetchFailRequest
  Text
arg_pFetchFailRequestRequestId
  NetworkErrorReason
arg_pFetchFailRequestErrorReason
  = Text -> NetworkErrorReason -> PFetchFailRequest
PFetchFailRequest
    Text
arg_pFetchFailRequestRequestId
    NetworkErrorReason
arg_pFetchFailRequestErrorReason
instance ToJSON PFetchFailRequest where
  toJSON :: PFetchFailRequest -> Value
toJSON PFetchFailRequest
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
"requestId" 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 (PFetchFailRequest -> Text
pFetchFailRequestRequestId PFetchFailRequest
p),
    (Text
"errorReason" Text -> NetworkErrorReason -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (NetworkErrorReason -> Pair)
-> Maybe NetworkErrorReason -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkErrorReason -> Maybe NetworkErrorReason
forall a. a -> Maybe a
Just (PFetchFailRequest -> NetworkErrorReason
pFetchFailRequestErrorReason PFetchFailRequest
p)
    ]
instance Command PFetchFailRequest where
  type CommandResponse PFetchFailRequest = ()
  commandName :: Proxy PFetchFailRequest -> String
commandName Proxy PFetchFailRequest
_ = String
"Fetch.failRequest"
  fromJSON :: Proxy PFetchFailRequest
-> Value -> Result (CommandResponse PFetchFailRequest)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PFetchFailRequest -> Result ())
-> Proxy PFetchFailRequest
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PFetchFailRequest -> ())
-> Proxy PFetchFailRequest
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PFetchFailRequest -> ()
forall a b. a -> b -> a
const ()

-- | Provides response to the request.

-- | Parameters of the 'Fetch.fulfillRequest' command.
data PFetchFulfillRequest = PFetchFulfillRequest
  {
    -- | An id the client received in requestPaused event.
    PFetchFulfillRequest -> Text
pFetchFulfillRequestRequestId :: FetchRequestId,
    -- | An HTTP response code.
    PFetchFulfillRequest -> Int
pFetchFulfillRequestResponseCode :: Int,
    -- | Response headers.
    PFetchFulfillRequest -> Maybe [FetchHeaderEntry]
pFetchFulfillRequestResponseHeaders :: Maybe [FetchHeaderEntry],
    -- | Alternative way of specifying response headers as a \0-separated
    --   series of name: value pairs. Prefer the above method unless you
    --   need to represent some non-UTF8 values that can't be transmitted
    --   over the protocol as text. (Encoded as a base64 string when passed over JSON)
    PFetchFulfillRequest -> Maybe Text
pFetchFulfillRequestBinaryResponseHeaders :: Maybe T.Text,
    -- | A response body. If absent, original response body will be used if
    --   the request is intercepted at the response stage and empty body
    --   will be used if the request is intercepted at the request stage. (Encoded as a base64 string when passed over JSON)
    PFetchFulfillRequest -> Maybe Text
pFetchFulfillRequestBody :: Maybe T.Text,
    -- | A textual representation of responseCode.
    --   If absent, a standard phrase matching responseCode is used.
    PFetchFulfillRequest -> Maybe Text
pFetchFulfillRequestResponsePhrase :: Maybe T.Text
  }
  deriving (PFetchFulfillRequest -> PFetchFulfillRequest -> Bool
(PFetchFulfillRequest -> PFetchFulfillRequest -> Bool)
-> (PFetchFulfillRequest -> PFetchFulfillRequest -> Bool)
-> Eq PFetchFulfillRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFetchFulfillRequest -> PFetchFulfillRequest -> Bool
$c/= :: PFetchFulfillRequest -> PFetchFulfillRequest -> Bool
== :: PFetchFulfillRequest -> PFetchFulfillRequest -> Bool
$c== :: PFetchFulfillRequest -> PFetchFulfillRequest -> Bool
Eq, Int -> PFetchFulfillRequest -> ShowS
[PFetchFulfillRequest] -> ShowS
PFetchFulfillRequest -> String
(Int -> PFetchFulfillRequest -> ShowS)
-> (PFetchFulfillRequest -> String)
-> ([PFetchFulfillRequest] -> ShowS)
-> Show PFetchFulfillRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFetchFulfillRequest] -> ShowS
$cshowList :: [PFetchFulfillRequest] -> ShowS
show :: PFetchFulfillRequest -> String
$cshow :: PFetchFulfillRequest -> String
showsPrec :: Int -> PFetchFulfillRequest -> ShowS
$cshowsPrec :: Int -> PFetchFulfillRequest -> ShowS
Show)
pFetchFulfillRequest
  {-
  -- | An id the client received in requestPaused event.
  -}
  :: FetchRequestId
  {-
  -- | An HTTP response code.
  -}
  -> Int
  -> PFetchFulfillRequest
pFetchFulfillRequest :: Text -> Int -> PFetchFulfillRequest
pFetchFulfillRequest
  Text
arg_pFetchFulfillRequestRequestId
  Int
arg_pFetchFulfillRequestResponseCode
  = Text
-> Int
-> Maybe [FetchHeaderEntry]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PFetchFulfillRequest
PFetchFulfillRequest
    Text
arg_pFetchFulfillRequestRequestId
    Int
arg_pFetchFulfillRequestResponseCode
    Maybe [FetchHeaderEntry]
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PFetchFulfillRequest where
  toJSON :: PFetchFulfillRequest -> Value
toJSON PFetchFulfillRequest
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
"requestId" 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 (PFetchFulfillRequest -> Text
pFetchFulfillRequestRequestId PFetchFulfillRequest
p),
    (Text
"responseCode" 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
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (PFetchFulfillRequest -> Int
pFetchFulfillRequestResponseCode PFetchFulfillRequest
p),
    (Text
"responseHeaders" Text -> [FetchHeaderEntry] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([FetchHeaderEntry] -> Pair)
-> Maybe [FetchHeaderEntry] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PFetchFulfillRequest -> Maybe [FetchHeaderEntry]
pFetchFulfillRequestResponseHeaders PFetchFulfillRequest
p),
    (Text
"binaryResponseHeaders" 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
<$> (PFetchFulfillRequest -> Maybe Text
pFetchFulfillRequestBinaryResponseHeaders PFetchFulfillRequest
p),
    (Text
"body" 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
<$> (PFetchFulfillRequest -> Maybe Text
pFetchFulfillRequestBody PFetchFulfillRequest
p),
    (Text
"responsePhrase" 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
<$> (PFetchFulfillRequest -> Maybe Text
pFetchFulfillRequestResponsePhrase PFetchFulfillRequest
p)
    ]
instance Command PFetchFulfillRequest where
  type CommandResponse PFetchFulfillRequest = ()
  commandName :: Proxy PFetchFulfillRequest -> String
commandName Proxy PFetchFulfillRequest
_ = String
"Fetch.fulfillRequest"
  fromJSON :: Proxy PFetchFulfillRequest
-> Value -> Result (CommandResponse PFetchFulfillRequest)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PFetchFulfillRequest -> Result ())
-> Proxy PFetchFulfillRequest
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PFetchFulfillRequest -> ())
-> Proxy PFetchFulfillRequest
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PFetchFulfillRequest -> ()
forall a b. a -> b -> a
const ()

-- | Continues the request, optionally modifying some of its parameters.

-- | Parameters of the 'Fetch.continueRequest' command.
data PFetchContinueRequest = PFetchContinueRequest
  {
    -- | An id the client received in requestPaused event.
    PFetchContinueRequest -> Text
pFetchContinueRequestRequestId :: FetchRequestId,
    -- | If set, the request url will be modified in a way that's not observable by page.
    PFetchContinueRequest -> Maybe Text
pFetchContinueRequestUrl :: Maybe T.Text,
    -- | If set, the request method is overridden.
    PFetchContinueRequest -> Maybe Text
pFetchContinueRequestMethod :: Maybe T.Text,
    -- | If set, overrides the post data in the request. (Encoded as a base64 string when passed over JSON)
    PFetchContinueRequest -> Maybe Text
pFetchContinueRequestPostData :: Maybe T.Text,
    -- | If set, overrides the request headers. Note that the overrides do not
    --   extend to subsequent redirect hops, if a redirect happens. Another override
    --   may be applied to a different request produced by a redirect.
    PFetchContinueRequest -> Maybe [FetchHeaderEntry]
pFetchContinueRequestHeaders :: Maybe [FetchHeaderEntry],
    -- | If set, overrides response interception behavior for this request.
    PFetchContinueRequest -> Maybe Bool
pFetchContinueRequestInterceptResponse :: Maybe Bool
  }
  deriving (PFetchContinueRequest -> PFetchContinueRequest -> Bool
(PFetchContinueRequest -> PFetchContinueRequest -> Bool)
-> (PFetchContinueRequest -> PFetchContinueRequest -> Bool)
-> Eq PFetchContinueRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFetchContinueRequest -> PFetchContinueRequest -> Bool
$c/= :: PFetchContinueRequest -> PFetchContinueRequest -> Bool
== :: PFetchContinueRequest -> PFetchContinueRequest -> Bool
$c== :: PFetchContinueRequest -> PFetchContinueRequest -> Bool
Eq, Int -> PFetchContinueRequest -> ShowS
[PFetchContinueRequest] -> ShowS
PFetchContinueRequest -> String
(Int -> PFetchContinueRequest -> ShowS)
-> (PFetchContinueRequest -> String)
-> ([PFetchContinueRequest] -> ShowS)
-> Show PFetchContinueRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFetchContinueRequest] -> ShowS
$cshowList :: [PFetchContinueRequest] -> ShowS
show :: PFetchContinueRequest -> String
$cshow :: PFetchContinueRequest -> String
showsPrec :: Int -> PFetchContinueRequest -> ShowS
$cshowsPrec :: Int -> PFetchContinueRequest -> ShowS
Show)
pFetchContinueRequest
  {-
  -- | An id the client received in requestPaused event.
  -}
  :: FetchRequestId
  -> PFetchContinueRequest
pFetchContinueRequest :: Text -> PFetchContinueRequest
pFetchContinueRequest
  Text
arg_pFetchContinueRequestRequestId
  = Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [FetchHeaderEntry]
-> Maybe Bool
-> PFetchContinueRequest
PFetchContinueRequest
    Text
arg_pFetchContinueRequestRequestId
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Maybe [FetchHeaderEntry]
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PFetchContinueRequest where
  toJSON :: PFetchContinueRequest -> Value
toJSON PFetchContinueRequest
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
"requestId" 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 (PFetchContinueRequest -> Text
pFetchContinueRequestRequestId PFetchContinueRequest
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
<$> (PFetchContinueRequest -> Maybe Text
pFetchContinueRequestUrl PFetchContinueRequest
p),
    (Text
"method" 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
<$> (PFetchContinueRequest -> Maybe Text
pFetchContinueRequestMethod PFetchContinueRequest
p),
    (Text
"postData" 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
<$> (PFetchContinueRequest -> Maybe Text
pFetchContinueRequestPostData PFetchContinueRequest
p),
    (Text
"headers" Text -> [FetchHeaderEntry] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([FetchHeaderEntry] -> Pair)
-> Maybe [FetchHeaderEntry] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PFetchContinueRequest -> Maybe [FetchHeaderEntry]
pFetchContinueRequestHeaders PFetchContinueRequest
p),
    (Text
"interceptResponse" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PFetchContinueRequest -> Maybe Bool
pFetchContinueRequestInterceptResponse PFetchContinueRequest
p)
    ]
instance Command PFetchContinueRequest where
  type CommandResponse PFetchContinueRequest = ()
  commandName :: Proxy PFetchContinueRequest -> String
commandName Proxy PFetchContinueRequest
_ = String
"Fetch.continueRequest"
  fromJSON :: Proxy PFetchContinueRequest
-> Value -> Result (CommandResponse PFetchContinueRequest)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PFetchContinueRequest -> Result ())
-> Proxy PFetchContinueRequest
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PFetchContinueRequest -> ())
-> Proxy PFetchContinueRequest
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PFetchContinueRequest -> ()
forall a b. a -> b -> a
const ()

-- | Continues a request supplying authChallengeResponse following authRequired event.

-- | Parameters of the 'Fetch.continueWithAuth' command.
data PFetchContinueWithAuth = PFetchContinueWithAuth
  {
    -- | An id the client received in authRequired event.
    PFetchContinueWithAuth -> Text
pFetchContinueWithAuthRequestId :: FetchRequestId,
    -- | Response to  with an authChallenge.
    PFetchContinueWithAuth -> FetchAuthChallengeResponse
pFetchContinueWithAuthAuthChallengeResponse :: FetchAuthChallengeResponse
  }
  deriving (PFetchContinueWithAuth -> PFetchContinueWithAuth -> Bool
(PFetchContinueWithAuth -> PFetchContinueWithAuth -> Bool)
-> (PFetchContinueWithAuth -> PFetchContinueWithAuth -> Bool)
-> Eq PFetchContinueWithAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFetchContinueWithAuth -> PFetchContinueWithAuth -> Bool
$c/= :: PFetchContinueWithAuth -> PFetchContinueWithAuth -> Bool
== :: PFetchContinueWithAuth -> PFetchContinueWithAuth -> Bool
$c== :: PFetchContinueWithAuth -> PFetchContinueWithAuth -> Bool
Eq, Int -> PFetchContinueWithAuth -> ShowS
[PFetchContinueWithAuth] -> ShowS
PFetchContinueWithAuth -> String
(Int -> PFetchContinueWithAuth -> ShowS)
-> (PFetchContinueWithAuth -> String)
-> ([PFetchContinueWithAuth] -> ShowS)
-> Show PFetchContinueWithAuth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFetchContinueWithAuth] -> ShowS
$cshowList :: [PFetchContinueWithAuth] -> ShowS
show :: PFetchContinueWithAuth -> String
$cshow :: PFetchContinueWithAuth -> String
showsPrec :: Int -> PFetchContinueWithAuth -> ShowS
$cshowsPrec :: Int -> PFetchContinueWithAuth -> ShowS
Show)
pFetchContinueWithAuth
  {-
  -- | An id the client received in authRequired event.
  -}
  :: FetchRequestId
  {-
  -- | Response to  with an authChallenge.
  -}
  -> FetchAuthChallengeResponse
  -> PFetchContinueWithAuth
pFetchContinueWithAuth :: Text -> FetchAuthChallengeResponse -> PFetchContinueWithAuth
pFetchContinueWithAuth
  Text
arg_pFetchContinueWithAuthRequestId
  FetchAuthChallengeResponse
arg_pFetchContinueWithAuthAuthChallengeResponse
  = Text -> FetchAuthChallengeResponse -> PFetchContinueWithAuth
PFetchContinueWithAuth
    Text
arg_pFetchContinueWithAuthRequestId
    FetchAuthChallengeResponse
arg_pFetchContinueWithAuthAuthChallengeResponse
instance ToJSON PFetchContinueWithAuth where
  toJSON :: PFetchContinueWithAuth -> Value
toJSON PFetchContinueWithAuth
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
"requestId" 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 (PFetchContinueWithAuth -> Text
pFetchContinueWithAuthRequestId PFetchContinueWithAuth
p),
    (Text
"authChallengeResponse" Text -> FetchAuthChallengeResponse -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (FetchAuthChallengeResponse -> Pair)
-> Maybe FetchAuthChallengeResponse -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FetchAuthChallengeResponse -> Maybe FetchAuthChallengeResponse
forall a. a -> Maybe a
Just (PFetchContinueWithAuth -> FetchAuthChallengeResponse
pFetchContinueWithAuthAuthChallengeResponse PFetchContinueWithAuth
p)
    ]
instance Command PFetchContinueWithAuth where
  type CommandResponse PFetchContinueWithAuth = ()
  commandName :: Proxy PFetchContinueWithAuth -> String
commandName Proxy PFetchContinueWithAuth
_ = String
"Fetch.continueWithAuth"
  fromJSON :: Proxy PFetchContinueWithAuth
-> Value -> Result (CommandResponse PFetchContinueWithAuth)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PFetchContinueWithAuth -> Result ())
-> Proxy PFetchContinueWithAuth
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PFetchContinueWithAuth -> ())
-> Proxy PFetchContinueWithAuth
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PFetchContinueWithAuth -> ()
forall a b. a -> b -> a
const ()

-- | Continues loading of the paused response, optionally modifying the
--   response headers. If either responseCode or headers are modified, all of them
--   must be present.

-- | Parameters of the 'Fetch.continueResponse' command.
data PFetchContinueResponse = PFetchContinueResponse
  {
    -- | An id the client received in requestPaused event.
    PFetchContinueResponse -> Text
pFetchContinueResponseRequestId :: FetchRequestId,
    -- | An HTTP response code. If absent, original response code will be used.
    PFetchContinueResponse -> Maybe Int
pFetchContinueResponseResponseCode :: Maybe Int,
    -- | A textual representation of responseCode.
    --   If absent, a standard phrase matching responseCode is used.
    PFetchContinueResponse -> Maybe Text
pFetchContinueResponseResponsePhrase :: Maybe T.Text,
    -- | Response headers. If absent, original response headers will be used.
    PFetchContinueResponse -> Maybe [FetchHeaderEntry]
pFetchContinueResponseResponseHeaders :: Maybe [FetchHeaderEntry],
    -- | Alternative way of specifying response headers as a \0-separated
    --   series of name: value pairs. Prefer the above method unless you
    --   need to represent some non-UTF8 values that can't be transmitted
    --   over the protocol as text. (Encoded as a base64 string when passed over JSON)
    PFetchContinueResponse -> Maybe Text
pFetchContinueResponseBinaryResponseHeaders :: Maybe T.Text
  }
  deriving (PFetchContinueResponse -> PFetchContinueResponse -> Bool
(PFetchContinueResponse -> PFetchContinueResponse -> Bool)
-> (PFetchContinueResponse -> PFetchContinueResponse -> Bool)
-> Eq PFetchContinueResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFetchContinueResponse -> PFetchContinueResponse -> Bool
$c/= :: PFetchContinueResponse -> PFetchContinueResponse -> Bool
== :: PFetchContinueResponse -> PFetchContinueResponse -> Bool
$c== :: PFetchContinueResponse -> PFetchContinueResponse -> Bool
Eq, Int -> PFetchContinueResponse -> ShowS
[PFetchContinueResponse] -> ShowS
PFetchContinueResponse -> String
(Int -> PFetchContinueResponse -> ShowS)
-> (PFetchContinueResponse -> String)
-> ([PFetchContinueResponse] -> ShowS)
-> Show PFetchContinueResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFetchContinueResponse] -> ShowS
$cshowList :: [PFetchContinueResponse] -> ShowS
show :: PFetchContinueResponse -> String
$cshow :: PFetchContinueResponse -> String
showsPrec :: Int -> PFetchContinueResponse -> ShowS
$cshowsPrec :: Int -> PFetchContinueResponse -> ShowS
Show)
pFetchContinueResponse
  {-
  -- | An id the client received in requestPaused event.
  -}
  :: FetchRequestId
  -> PFetchContinueResponse
pFetchContinueResponse :: Text -> PFetchContinueResponse
pFetchContinueResponse
  Text
arg_pFetchContinueResponseRequestId
  = Text
-> Maybe Int
-> Maybe Text
-> Maybe [FetchHeaderEntry]
-> Maybe Text
-> PFetchContinueResponse
PFetchContinueResponse
    Text
arg_pFetchContinueResponseRequestId
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Maybe [FetchHeaderEntry]
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PFetchContinueResponse where
  toJSON :: PFetchContinueResponse -> Value
toJSON PFetchContinueResponse
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
"requestId" 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 (PFetchContinueResponse -> Text
pFetchContinueResponseRequestId PFetchContinueResponse
p),
    (Text
"responseCode" 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
<$> (PFetchContinueResponse -> Maybe Int
pFetchContinueResponseResponseCode PFetchContinueResponse
p),
    (Text
"responsePhrase" 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
<$> (PFetchContinueResponse -> Maybe Text
pFetchContinueResponseResponsePhrase PFetchContinueResponse
p),
    (Text
"responseHeaders" Text -> [FetchHeaderEntry] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([FetchHeaderEntry] -> Pair)
-> Maybe [FetchHeaderEntry] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PFetchContinueResponse -> Maybe [FetchHeaderEntry]
pFetchContinueResponseResponseHeaders PFetchContinueResponse
p),
    (Text
"binaryResponseHeaders" 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
<$> (PFetchContinueResponse -> Maybe Text
pFetchContinueResponseBinaryResponseHeaders PFetchContinueResponse
p)
    ]
instance Command PFetchContinueResponse where
  type CommandResponse PFetchContinueResponse = ()
  commandName :: Proxy PFetchContinueResponse -> String
commandName Proxy PFetchContinueResponse
_ = String
"Fetch.continueResponse"
  fromJSON :: Proxy PFetchContinueResponse
-> Value -> Result (CommandResponse PFetchContinueResponse)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PFetchContinueResponse -> Result ())
-> Proxy PFetchContinueResponse
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PFetchContinueResponse -> ())
-> Proxy PFetchContinueResponse
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PFetchContinueResponse -> ()
forall a b. a -> b -> a
const ()

-- | Causes the body of the response to be received from the server and
--   returned as a single string. May only be issued for a request that
--   is paused in the Response stage and is mutually exclusive with
--   takeResponseBodyForInterceptionAsStream. Calling other methods that
--   affect the request or disabling fetch domain before body is received
--   results in an undefined behavior.

-- | Parameters of the 'Fetch.getResponseBody' command.
data PFetchGetResponseBody = PFetchGetResponseBody
  {
    -- | Identifier for the intercepted request to get body for.
    PFetchGetResponseBody -> Text
pFetchGetResponseBodyRequestId :: FetchRequestId
  }
  deriving (PFetchGetResponseBody -> PFetchGetResponseBody -> Bool
(PFetchGetResponseBody -> PFetchGetResponseBody -> Bool)
-> (PFetchGetResponseBody -> PFetchGetResponseBody -> Bool)
-> Eq PFetchGetResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFetchGetResponseBody -> PFetchGetResponseBody -> Bool
$c/= :: PFetchGetResponseBody -> PFetchGetResponseBody -> Bool
== :: PFetchGetResponseBody -> PFetchGetResponseBody -> Bool
$c== :: PFetchGetResponseBody -> PFetchGetResponseBody -> Bool
Eq, Int -> PFetchGetResponseBody -> ShowS
[PFetchGetResponseBody] -> ShowS
PFetchGetResponseBody -> String
(Int -> PFetchGetResponseBody -> ShowS)
-> (PFetchGetResponseBody -> String)
-> ([PFetchGetResponseBody] -> ShowS)
-> Show PFetchGetResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFetchGetResponseBody] -> ShowS
$cshowList :: [PFetchGetResponseBody] -> ShowS
show :: PFetchGetResponseBody -> String
$cshow :: PFetchGetResponseBody -> String
showsPrec :: Int -> PFetchGetResponseBody -> ShowS
$cshowsPrec :: Int -> PFetchGetResponseBody -> ShowS
Show)
pFetchGetResponseBody
  {-
  -- | Identifier for the intercepted request to get body for.
  -}
  :: FetchRequestId
  -> PFetchGetResponseBody
pFetchGetResponseBody :: Text -> PFetchGetResponseBody
pFetchGetResponseBody
  Text
arg_pFetchGetResponseBodyRequestId
  = Text -> PFetchGetResponseBody
PFetchGetResponseBody
    Text
arg_pFetchGetResponseBodyRequestId
instance ToJSON PFetchGetResponseBody where
  toJSON :: PFetchGetResponseBody -> Value
toJSON PFetchGetResponseBody
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
"requestId" 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 (PFetchGetResponseBody -> Text
pFetchGetResponseBodyRequestId PFetchGetResponseBody
p)
    ]
data FetchGetResponseBody = FetchGetResponseBody
  {
    -- | Response body.
    FetchGetResponseBody -> Text
fetchGetResponseBodyBody :: T.Text,
    -- | True, if content was sent as base64.
    FetchGetResponseBody -> Bool
fetchGetResponseBodyBase64Encoded :: Bool
  }
  deriving (FetchGetResponseBody -> FetchGetResponseBody -> Bool
(FetchGetResponseBody -> FetchGetResponseBody -> Bool)
-> (FetchGetResponseBody -> FetchGetResponseBody -> Bool)
-> Eq FetchGetResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchGetResponseBody -> FetchGetResponseBody -> Bool
$c/= :: FetchGetResponseBody -> FetchGetResponseBody -> Bool
== :: FetchGetResponseBody -> FetchGetResponseBody -> Bool
$c== :: FetchGetResponseBody -> FetchGetResponseBody -> Bool
Eq, Int -> FetchGetResponseBody -> ShowS
[FetchGetResponseBody] -> ShowS
FetchGetResponseBody -> String
(Int -> FetchGetResponseBody -> ShowS)
-> (FetchGetResponseBody -> String)
-> ([FetchGetResponseBody] -> ShowS)
-> Show FetchGetResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchGetResponseBody] -> ShowS
$cshowList :: [FetchGetResponseBody] -> ShowS
show :: FetchGetResponseBody -> String
$cshow :: FetchGetResponseBody -> String
showsPrec :: Int -> FetchGetResponseBody -> ShowS
$cshowsPrec :: Int -> FetchGetResponseBody -> ShowS
Show)
instance FromJSON FetchGetResponseBody where
  parseJSON :: Value -> Parser FetchGetResponseBody
parseJSON = String
-> (Object -> Parser FetchGetResponseBody)
-> Value
-> Parser FetchGetResponseBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FetchGetResponseBody" ((Object -> Parser FetchGetResponseBody)
 -> Value -> Parser FetchGetResponseBody)
-> (Object -> Parser FetchGetResponseBody)
-> Value
-> Parser FetchGetResponseBody
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Bool -> FetchGetResponseBody
FetchGetResponseBody
    (Text -> Bool -> FetchGetResponseBody)
-> Parser Text -> Parser (Bool -> FetchGetResponseBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"body"
    Parser (Bool -> FetchGetResponseBody)
-> Parser Bool -> Parser FetchGetResponseBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"base64Encoded"
instance Command PFetchGetResponseBody where
  type CommandResponse PFetchGetResponseBody = FetchGetResponseBody
  commandName :: Proxy PFetchGetResponseBody -> String
commandName Proxy PFetchGetResponseBody
_ = String
"Fetch.getResponseBody"

-- | Returns a handle to the stream representing the response body.
--   The request must be paused in the HeadersReceived stage.
--   Note that after this command the request can't be continued
--   as is -- client either needs to cancel it or to provide the
--   response body.
--   The stream only supports sequential read, IO.read will fail if the position
--   is specified.
--   This method is mutually exclusive with getResponseBody.
--   Calling other methods that affect the request or disabling fetch
--   domain before body is received results in an undefined behavior.

-- | Parameters of the 'Fetch.takeResponseBodyAsStream' command.
data PFetchTakeResponseBodyAsStream = PFetchTakeResponseBodyAsStream
  {
    PFetchTakeResponseBodyAsStream -> Text
pFetchTakeResponseBodyAsStreamRequestId :: FetchRequestId
  }
  deriving (PFetchTakeResponseBodyAsStream
-> PFetchTakeResponseBodyAsStream -> Bool
(PFetchTakeResponseBodyAsStream
 -> PFetchTakeResponseBodyAsStream -> Bool)
-> (PFetchTakeResponseBodyAsStream
    -> PFetchTakeResponseBodyAsStream -> Bool)
-> Eq PFetchTakeResponseBodyAsStream
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFetchTakeResponseBodyAsStream
-> PFetchTakeResponseBodyAsStream -> Bool
$c/= :: PFetchTakeResponseBodyAsStream
-> PFetchTakeResponseBodyAsStream -> Bool
== :: PFetchTakeResponseBodyAsStream
-> PFetchTakeResponseBodyAsStream -> Bool
$c== :: PFetchTakeResponseBodyAsStream
-> PFetchTakeResponseBodyAsStream -> Bool
Eq, Int -> PFetchTakeResponseBodyAsStream -> ShowS
[PFetchTakeResponseBodyAsStream] -> ShowS
PFetchTakeResponseBodyAsStream -> String
(Int -> PFetchTakeResponseBodyAsStream -> ShowS)
-> (PFetchTakeResponseBodyAsStream -> String)
-> ([PFetchTakeResponseBodyAsStream] -> ShowS)
-> Show PFetchTakeResponseBodyAsStream
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFetchTakeResponseBodyAsStream] -> ShowS
$cshowList :: [PFetchTakeResponseBodyAsStream] -> ShowS
show :: PFetchTakeResponseBodyAsStream -> String
$cshow :: PFetchTakeResponseBodyAsStream -> String
showsPrec :: Int -> PFetchTakeResponseBodyAsStream -> ShowS
$cshowsPrec :: Int -> PFetchTakeResponseBodyAsStream -> ShowS
Show)
pFetchTakeResponseBodyAsStream
  :: FetchRequestId
  -> PFetchTakeResponseBodyAsStream
pFetchTakeResponseBodyAsStream :: Text -> PFetchTakeResponseBodyAsStream
pFetchTakeResponseBodyAsStream
  Text
arg_pFetchTakeResponseBodyAsStreamRequestId
  = Text -> PFetchTakeResponseBodyAsStream
PFetchTakeResponseBodyAsStream
    Text
arg_pFetchTakeResponseBodyAsStreamRequestId
instance ToJSON PFetchTakeResponseBodyAsStream where
  toJSON :: PFetchTakeResponseBodyAsStream -> Value
toJSON PFetchTakeResponseBodyAsStream
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
"requestId" 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 (PFetchTakeResponseBodyAsStream -> Text
pFetchTakeResponseBodyAsStreamRequestId PFetchTakeResponseBodyAsStream
p)
    ]
data FetchTakeResponseBodyAsStream = FetchTakeResponseBodyAsStream
  {
    FetchTakeResponseBodyAsStream -> Text
fetchTakeResponseBodyAsStreamStream :: IO.IOStreamHandle
  }
  deriving (FetchTakeResponseBodyAsStream
-> FetchTakeResponseBodyAsStream -> Bool
(FetchTakeResponseBodyAsStream
 -> FetchTakeResponseBodyAsStream -> Bool)
-> (FetchTakeResponseBodyAsStream
    -> FetchTakeResponseBodyAsStream -> Bool)
-> Eq FetchTakeResponseBodyAsStream
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchTakeResponseBodyAsStream
-> FetchTakeResponseBodyAsStream -> Bool
$c/= :: FetchTakeResponseBodyAsStream
-> FetchTakeResponseBodyAsStream -> Bool
== :: FetchTakeResponseBodyAsStream
-> FetchTakeResponseBodyAsStream -> Bool
$c== :: FetchTakeResponseBodyAsStream
-> FetchTakeResponseBodyAsStream -> Bool
Eq, Int -> FetchTakeResponseBodyAsStream -> ShowS
[FetchTakeResponseBodyAsStream] -> ShowS
FetchTakeResponseBodyAsStream -> String
(Int -> FetchTakeResponseBodyAsStream -> ShowS)
-> (FetchTakeResponseBodyAsStream -> String)
-> ([FetchTakeResponseBodyAsStream] -> ShowS)
-> Show FetchTakeResponseBodyAsStream
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchTakeResponseBodyAsStream] -> ShowS
$cshowList :: [FetchTakeResponseBodyAsStream] -> ShowS
show :: FetchTakeResponseBodyAsStream -> String
$cshow :: FetchTakeResponseBodyAsStream -> String
showsPrec :: Int -> FetchTakeResponseBodyAsStream -> ShowS
$cshowsPrec :: Int -> FetchTakeResponseBodyAsStream -> ShowS
Show)
instance FromJSON FetchTakeResponseBodyAsStream where
  parseJSON :: Value -> Parser FetchTakeResponseBodyAsStream
parseJSON = String
-> (Object -> Parser FetchTakeResponseBodyAsStream)
-> Value
-> Parser FetchTakeResponseBodyAsStream
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FetchTakeResponseBodyAsStream" ((Object -> Parser FetchTakeResponseBodyAsStream)
 -> Value -> Parser FetchTakeResponseBodyAsStream)
-> (Object -> Parser FetchTakeResponseBodyAsStream)
-> Value
-> Parser FetchTakeResponseBodyAsStream
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> FetchTakeResponseBodyAsStream
FetchTakeResponseBodyAsStream
    (Text -> FetchTakeResponseBodyAsStream)
-> Parser Text -> Parser FetchTakeResponseBodyAsStream
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"stream"
instance Command PFetchTakeResponseBodyAsStream where
  type CommandResponse PFetchTakeResponseBodyAsStream = FetchTakeResponseBodyAsStream
  commandName :: Proxy PFetchTakeResponseBodyAsStream -> String
commandName Proxy PFetchTakeResponseBodyAsStream
_ = String
"Fetch.takeResponseBodyAsStream"