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


{- |
= Storage

-}


module CDP.Domains.Storage (module CDP.Domains.Storage) 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.BrowserTarget as BrowserTarget
import CDP.Domains.DOMPageNetworkEmulationSecurity as DOMPageNetworkEmulationSecurity


-- | Type 'Storage.SerializedStorageKey'.
type StorageSerializedStorageKey = T.Text

-- | Type 'Storage.StorageType'.
--   Enum of possible storage types.
data StorageStorageType = StorageStorageTypeAppcache | StorageStorageTypeCookies | StorageStorageTypeFile_systems | StorageStorageTypeIndexeddb | StorageStorageTypeLocal_storage | StorageStorageTypeShader_cache | StorageStorageTypeWebsql | StorageStorageTypeService_workers | StorageStorageTypeCache_storage | StorageStorageTypeInterest_groups | StorageStorageTypeAll | StorageStorageTypeOther
  deriving (Eq StorageStorageType
Eq StorageStorageType
-> (StorageStorageType -> StorageStorageType -> Ordering)
-> (StorageStorageType -> StorageStorageType -> Bool)
-> (StorageStorageType -> StorageStorageType -> Bool)
-> (StorageStorageType -> StorageStorageType -> Bool)
-> (StorageStorageType -> StorageStorageType -> Bool)
-> (StorageStorageType -> StorageStorageType -> StorageStorageType)
-> (StorageStorageType -> StorageStorageType -> StorageStorageType)
-> Ord StorageStorageType
StorageStorageType -> StorageStorageType -> Bool
StorageStorageType -> StorageStorageType -> Ordering
StorageStorageType -> StorageStorageType -> StorageStorageType
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 :: StorageStorageType -> StorageStorageType -> StorageStorageType
$cmin :: StorageStorageType -> StorageStorageType -> StorageStorageType
max :: StorageStorageType -> StorageStorageType -> StorageStorageType
$cmax :: StorageStorageType -> StorageStorageType -> StorageStorageType
>= :: StorageStorageType -> StorageStorageType -> Bool
$c>= :: StorageStorageType -> StorageStorageType -> Bool
> :: StorageStorageType -> StorageStorageType -> Bool
$c> :: StorageStorageType -> StorageStorageType -> Bool
<= :: StorageStorageType -> StorageStorageType -> Bool
$c<= :: StorageStorageType -> StorageStorageType -> Bool
< :: StorageStorageType -> StorageStorageType -> Bool
$c< :: StorageStorageType -> StorageStorageType -> Bool
compare :: StorageStorageType -> StorageStorageType -> Ordering
$ccompare :: StorageStorageType -> StorageStorageType -> Ordering
$cp1Ord :: Eq StorageStorageType
Ord, StorageStorageType -> StorageStorageType -> Bool
(StorageStorageType -> StorageStorageType -> Bool)
-> (StorageStorageType -> StorageStorageType -> Bool)
-> Eq StorageStorageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageStorageType -> StorageStorageType -> Bool
$c/= :: StorageStorageType -> StorageStorageType -> Bool
== :: StorageStorageType -> StorageStorageType -> Bool
$c== :: StorageStorageType -> StorageStorageType -> Bool
Eq, Int -> StorageStorageType -> ShowS
[StorageStorageType] -> ShowS
StorageStorageType -> String
(Int -> StorageStorageType -> ShowS)
-> (StorageStorageType -> String)
-> ([StorageStorageType] -> ShowS)
-> Show StorageStorageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageStorageType] -> ShowS
$cshowList :: [StorageStorageType] -> ShowS
show :: StorageStorageType -> String
$cshow :: StorageStorageType -> String
showsPrec :: Int -> StorageStorageType -> ShowS
$cshowsPrec :: Int -> StorageStorageType -> ShowS
Show, ReadPrec [StorageStorageType]
ReadPrec StorageStorageType
Int -> ReadS StorageStorageType
ReadS [StorageStorageType]
(Int -> ReadS StorageStorageType)
-> ReadS [StorageStorageType]
-> ReadPrec StorageStorageType
-> ReadPrec [StorageStorageType]
-> Read StorageStorageType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StorageStorageType]
$creadListPrec :: ReadPrec [StorageStorageType]
readPrec :: ReadPrec StorageStorageType
$creadPrec :: ReadPrec StorageStorageType
readList :: ReadS [StorageStorageType]
$creadList :: ReadS [StorageStorageType]
readsPrec :: Int -> ReadS StorageStorageType
$creadsPrec :: Int -> ReadS StorageStorageType
Read)
instance FromJSON StorageStorageType where
  parseJSON :: Value -> Parser StorageStorageType
parseJSON = String
-> (Text -> Parser StorageStorageType)
-> Value
-> Parser StorageStorageType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"StorageStorageType" ((Text -> Parser StorageStorageType)
 -> Value -> Parser StorageStorageType)
-> (Text -> Parser StorageStorageType)
-> Value
-> Parser StorageStorageType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"appcache" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeAppcache
    Text
"cookies" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeCookies
    Text
"file_systems" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeFile_systems
    Text
"indexeddb" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeIndexeddb
    Text
"local_storage" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeLocal_storage
    Text
"shader_cache" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeShader_cache
    Text
"websql" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeWebsql
    Text
"service_workers" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeService_workers
    Text
"cache_storage" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeCache_storage
    Text
"interest_groups" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeInterest_groups
    Text
"all" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeAll
    Text
"other" -> StorageStorageType -> Parser StorageStorageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageStorageType
StorageStorageTypeOther
    Text
"_" -> String -> Parser StorageStorageType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse StorageStorageType"
instance ToJSON StorageStorageType where
  toJSON :: StorageStorageType -> Value
toJSON StorageStorageType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case StorageStorageType
v of
    StorageStorageType
StorageStorageTypeAppcache -> Text
"appcache"
    StorageStorageType
StorageStorageTypeCookies -> Text
"cookies"
    StorageStorageType
StorageStorageTypeFile_systems -> Text
"file_systems"
    StorageStorageType
StorageStorageTypeIndexeddb -> Text
"indexeddb"
    StorageStorageType
StorageStorageTypeLocal_storage -> Text
"local_storage"
    StorageStorageType
StorageStorageTypeShader_cache -> Text
"shader_cache"
    StorageStorageType
StorageStorageTypeWebsql -> Text
"websql"
    StorageStorageType
StorageStorageTypeService_workers -> Text
"service_workers"
    StorageStorageType
StorageStorageTypeCache_storage -> Text
"cache_storage"
    StorageStorageType
StorageStorageTypeInterest_groups -> Text
"interest_groups"
    StorageStorageType
StorageStorageTypeAll -> Text
"all"
    StorageStorageType
StorageStorageTypeOther -> Text
"other"

-- | Type 'Storage.UsageForType'.
--   Usage for a storage type.
data StorageUsageForType = StorageUsageForType
  {
    -- | Name of storage type.
    StorageUsageForType -> StorageStorageType
storageUsageForTypeStorageType :: StorageStorageType,
    -- | Storage usage (bytes).
    StorageUsageForType -> Double
storageUsageForTypeUsage :: Double
  }
  deriving (StorageUsageForType -> StorageUsageForType -> Bool
(StorageUsageForType -> StorageUsageForType -> Bool)
-> (StorageUsageForType -> StorageUsageForType -> Bool)
-> Eq StorageUsageForType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageUsageForType -> StorageUsageForType -> Bool
$c/= :: StorageUsageForType -> StorageUsageForType -> Bool
== :: StorageUsageForType -> StorageUsageForType -> Bool
$c== :: StorageUsageForType -> StorageUsageForType -> Bool
Eq, Int -> StorageUsageForType -> ShowS
[StorageUsageForType] -> ShowS
StorageUsageForType -> String
(Int -> StorageUsageForType -> ShowS)
-> (StorageUsageForType -> String)
-> ([StorageUsageForType] -> ShowS)
-> Show StorageUsageForType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageUsageForType] -> ShowS
$cshowList :: [StorageUsageForType] -> ShowS
show :: StorageUsageForType -> String
$cshow :: StorageUsageForType -> String
showsPrec :: Int -> StorageUsageForType -> ShowS
$cshowsPrec :: Int -> StorageUsageForType -> ShowS
Show)
instance FromJSON StorageUsageForType where
  parseJSON :: Value -> Parser StorageUsageForType
parseJSON = String
-> (Object -> Parser StorageUsageForType)
-> Value
-> Parser StorageUsageForType
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageUsageForType" ((Object -> Parser StorageUsageForType)
 -> Value -> Parser StorageUsageForType)
-> (Object -> Parser StorageUsageForType)
-> Value
-> Parser StorageUsageForType
forall a b. (a -> b) -> a -> b
$ \Object
o -> StorageStorageType -> Double -> StorageUsageForType
StorageUsageForType
    (StorageStorageType -> Double -> StorageUsageForType)
-> Parser StorageStorageType
-> Parser (Double -> StorageUsageForType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser StorageStorageType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"storageType"
    Parser (Double -> StorageUsageForType)
-> Parser Double -> Parser StorageUsageForType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"usage"
instance ToJSON StorageUsageForType where
  toJSON :: StorageUsageForType -> Value
toJSON StorageUsageForType
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
"storageType" Text -> StorageStorageType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (StorageStorageType -> Pair)
-> Maybe StorageStorageType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageStorageType -> Maybe StorageStorageType
forall a. a -> Maybe a
Just (StorageUsageForType -> StorageStorageType
storageUsageForTypeStorageType StorageUsageForType
p),
    (Text
"usage" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (StorageUsageForType -> Double
storageUsageForTypeUsage StorageUsageForType
p)
    ]

-- | Type 'Storage.TrustTokens'.
--   Pair of issuer origin and number of available (signed, but not used) Trust
--   Tokens from that issuer.
data StorageTrustTokens = StorageTrustTokens
  {
    StorageTrustTokens -> Text
storageTrustTokensIssuerOrigin :: T.Text,
    StorageTrustTokens -> Double
storageTrustTokensCount :: Double
  }
  deriving (StorageTrustTokens -> StorageTrustTokens -> Bool
(StorageTrustTokens -> StorageTrustTokens -> Bool)
-> (StorageTrustTokens -> StorageTrustTokens -> Bool)
-> Eq StorageTrustTokens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageTrustTokens -> StorageTrustTokens -> Bool
$c/= :: StorageTrustTokens -> StorageTrustTokens -> Bool
== :: StorageTrustTokens -> StorageTrustTokens -> Bool
$c== :: StorageTrustTokens -> StorageTrustTokens -> Bool
Eq, Int -> StorageTrustTokens -> ShowS
[StorageTrustTokens] -> ShowS
StorageTrustTokens -> String
(Int -> StorageTrustTokens -> ShowS)
-> (StorageTrustTokens -> String)
-> ([StorageTrustTokens] -> ShowS)
-> Show StorageTrustTokens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageTrustTokens] -> ShowS
$cshowList :: [StorageTrustTokens] -> ShowS
show :: StorageTrustTokens -> String
$cshow :: StorageTrustTokens -> String
showsPrec :: Int -> StorageTrustTokens -> ShowS
$cshowsPrec :: Int -> StorageTrustTokens -> ShowS
Show)
instance FromJSON StorageTrustTokens where
  parseJSON :: Value -> Parser StorageTrustTokens
parseJSON = String
-> (Object -> Parser StorageTrustTokens)
-> Value
-> Parser StorageTrustTokens
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageTrustTokens" ((Object -> Parser StorageTrustTokens)
 -> Value -> Parser StorageTrustTokens)
-> (Object -> Parser StorageTrustTokens)
-> Value
-> Parser StorageTrustTokens
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Double -> StorageTrustTokens
StorageTrustTokens
    (Text -> Double -> StorageTrustTokens)
-> Parser Text -> Parser (Double -> StorageTrustTokens)
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
"issuerOrigin"
    Parser (Double -> StorageTrustTokens)
-> Parser Double -> Parser StorageTrustTokens
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"count"
instance ToJSON StorageTrustTokens where
  toJSON :: StorageTrustTokens -> Value
toJSON StorageTrustTokens
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
"issuerOrigin" 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 (StorageTrustTokens -> Text
storageTrustTokensIssuerOrigin StorageTrustTokens
p),
    (Text
"count" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (StorageTrustTokens -> Double
storageTrustTokensCount StorageTrustTokens
p)
    ]

-- | Type 'Storage.InterestGroupAccessType'.
--   Enum of interest group access types.
data StorageInterestGroupAccessType = StorageInterestGroupAccessTypeJoin | StorageInterestGroupAccessTypeLeave | StorageInterestGroupAccessTypeUpdate | StorageInterestGroupAccessTypeBid | StorageInterestGroupAccessTypeWin
  deriving (Eq StorageInterestGroupAccessType
Eq StorageInterestGroupAccessType
-> (StorageInterestGroupAccessType
    -> StorageInterestGroupAccessType -> Ordering)
-> (StorageInterestGroupAccessType
    -> StorageInterestGroupAccessType -> Bool)
-> (StorageInterestGroupAccessType
    -> StorageInterestGroupAccessType -> Bool)
-> (StorageInterestGroupAccessType
    -> StorageInterestGroupAccessType -> Bool)
-> (StorageInterestGroupAccessType
    -> StorageInterestGroupAccessType -> Bool)
-> (StorageInterestGroupAccessType
    -> StorageInterestGroupAccessType
    -> StorageInterestGroupAccessType)
-> (StorageInterestGroupAccessType
    -> StorageInterestGroupAccessType
    -> StorageInterestGroupAccessType)
-> Ord StorageInterestGroupAccessType
StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Ordering
StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> StorageInterestGroupAccessType
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 :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> StorageInterestGroupAccessType
$cmin :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> StorageInterestGroupAccessType
max :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> StorageInterestGroupAccessType
$cmax :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> StorageInterestGroupAccessType
>= :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
$c>= :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
> :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
$c> :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
<= :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
$c<= :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
< :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
$c< :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
compare :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Ordering
$ccompare :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Ordering
$cp1Ord :: Eq StorageInterestGroupAccessType
Ord, StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
(StorageInterestGroupAccessType
 -> StorageInterestGroupAccessType -> Bool)
-> (StorageInterestGroupAccessType
    -> StorageInterestGroupAccessType -> Bool)
-> Eq StorageInterestGroupAccessType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
$c/= :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
== :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
$c== :: StorageInterestGroupAccessType
-> StorageInterestGroupAccessType -> Bool
Eq, Int -> StorageInterestGroupAccessType -> ShowS
[StorageInterestGroupAccessType] -> ShowS
StorageInterestGroupAccessType -> String
(Int -> StorageInterestGroupAccessType -> ShowS)
-> (StorageInterestGroupAccessType -> String)
-> ([StorageInterestGroupAccessType] -> ShowS)
-> Show StorageInterestGroupAccessType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageInterestGroupAccessType] -> ShowS
$cshowList :: [StorageInterestGroupAccessType] -> ShowS
show :: StorageInterestGroupAccessType -> String
$cshow :: StorageInterestGroupAccessType -> String
showsPrec :: Int -> StorageInterestGroupAccessType -> ShowS
$cshowsPrec :: Int -> StorageInterestGroupAccessType -> ShowS
Show, ReadPrec [StorageInterestGroupAccessType]
ReadPrec StorageInterestGroupAccessType
Int -> ReadS StorageInterestGroupAccessType
ReadS [StorageInterestGroupAccessType]
(Int -> ReadS StorageInterestGroupAccessType)
-> ReadS [StorageInterestGroupAccessType]
-> ReadPrec StorageInterestGroupAccessType
-> ReadPrec [StorageInterestGroupAccessType]
-> Read StorageInterestGroupAccessType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StorageInterestGroupAccessType]
$creadListPrec :: ReadPrec [StorageInterestGroupAccessType]
readPrec :: ReadPrec StorageInterestGroupAccessType
$creadPrec :: ReadPrec StorageInterestGroupAccessType
readList :: ReadS [StorageInterestGroupAccessType]
$creadList :: ReadS [StorageInterestGroupAccessType]
readsPrec :: Int -> ReadS StorageInterestGroupAccessType
$creadsPrec :: Int -> ReadS StorageInterestGroupAccessType
Read)
instance FromJSON StorageInterestGroupAccessType where
  parseJSON :: Value -> Parser StorageInterestGroupAccessType
parseJSON = String
-> (Text -> Parser StorageInterestGroupAccessType)
-> Value
-> Parser StorageInterestGroupAccessType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"StorageInterestGroupAccessType" ((Text -> Parser StorageInterestGroupAccessType)
 -> Value -> Parser StorageInterestGroupAccessType)
-> (Text -> Parser StorageInterestGroupAccessType)
-> Value
-> Parser StorageInterestGroupAccessType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"join" -> StorageInterestGroupAccessType
-> Parser StorageInterestGroupAccessType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageInterestGroupAccessType
StorageInterestGroupAccessTypeJoin
    Text
"leave" -> StorageInterestGroupAccessType
-> Parser StorageInterestGroupAccessType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageInterestGroupAccessType
StorageInterestGroupAccessTypeLeave
    Text
"update" -> StorageInterestGroupAccessType
-> Parser StorageInterestGroupAccessType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageInterestGroupAccessType
StorageInterestGroupAccessTypeUpdate
    Text
"bid" -> StorageInterestGroupAccessType
-> Parser StorageInterestGroupAccessType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageInterestGroupAccessType
StorageInterestGroupAccessTypeBid
    Text
"win" -> StorageInterestGroupAccessType
-> Parser StorageInterestGroupAccessType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageInterestGroupAccessType
StorageInterestGroupAccessTypeWin
    Text
"_" -> String -> Parser StorageInterestGroupAccessType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse StorageInterestGroupAccessType"
instance ToJSON StorageInterestGroupAccessType where
  toJSON :: StorageInterestGroupAccessType -> Value
toJSON StorageInterestGroupAccessType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case StorageInterestGroupAccessType
v of
    StorageInterestGroupAccessType
StorageInterestGroupAccessTypeJoin -> Text
"join"
    StorageInterestGroupAccessType
StorageInterestGroupAccessTypeLeave -> Text
"leave"
    StorageInterestGroupAccessType
StorageInterestGroupAccessTypeUpdate -> Text
"update"
    StorageInterestGroupAccessType
StorageInterestGroupAccessTypeBid -> Text
"bid"
    StorageInterestGroupAccessType
StorageInterestGroupAccessTypeWin -> Text
"win"

-- | Type 'Storage.InterestGroupAd'.
--   Ad advertising element inside an interest group.
data StorageInterestGroupAd = StorageInterestGroupAd
  {
    StorageInterestGroupAd -> Text
storageInterestGroupAdRenderUrl :: T.Text,
    StorageInterestGroupAd -> Maybe Text
storageInterestGroupAdMetadata :: Maybe T.Text
  }
  deriving (StorageInterestGroupAd -> StorageInterestGroupAd -> Bool
(StorageInterestGroupAd -> StorageInterestGroupAd -> Bool)
-> (StorageInterestGroupAd -> StorageInterestGroupAd -> Bool)
-> Eq StorageInterestGroupAd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageInterestGroupAd -> StorageInterestGroupAd -> Bool
$c/= :: StorageInterestGroupAd -> StorageInterestGroupAd -> Bool
== :: StorageInterestGroupAd -> StorageInterestGroupAd -> Bool
$c== :: StorageInterestGroupAd -> StorageInterestGroupAd -> Bool
Eq, Int -> StorageInterestGroupAd -> ShowS
[StorageInterestGroupAd] -> ShowS
StorageInterestGroupAd -> String
(Int -> StorageInterestGroupAd -> ShowS)
-> (StorageInterestGroupAd -> String)
-> ([StorageInterestGroupAd] -> ShowS)
-> Show StorageInterestGroupAd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageInterestGroupAd] -> ShowS
$cshowList :: [StorageInterestGroupAd] -> ShowS
show :: StorageInterestGroupAd -> String
$cshow :: StorageInterestGroupAd -> String
showsPrec :: Int -> StorageInterestGroupAd -> ShowS
$cshowsPrec :: Int -> StorageInterestGroupAd -> ShowS
Show)
instance FromJSON StorageInterestGroupAd where
  parseJSON :: Value -> Parser StorageInterestGroupAd
parseJSON = String
-> (Object -> Parser StorageInterestGroupAd)
-> Value
-> Parser StorageInterestGroupAd
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageInterestGroupAd" ((Object -> Parser StorageInterestGroupAd)
 -> Value -> Parser StorageInterestGroupAd)
-> (Object -> Parser StorageInterestGroupAd)
-> Value
-> Parser StorageInterestGroupAd
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Maybe Text -> StorageInterestGroupAd
StorageInterestGroupAd
    (Text -> Maybe Text -> StorageInterestGroupAd)
-> Parser Text -> Parser (Maybe Text -> StorageInterestGroupAd)
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
"renderUrl"
    Parser (Maybe Text -> StorageInterestGroupAd)
-> Parser (Maybe Text) -> Parser StorageInterestGroupAd
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
"metadata"
instance ToJSON StorageInterestGroupAd where
  toJSON :: StorageInterestGroupAd -> Value
toJSON StorageInterestGroupAd
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
"renderUrl" 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 (StorageInterestGroupAd -> Text
storageInterestGroupAdRenderUrl StorageInterestGroupAd
p),
    (Text
"metadata" 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
<$> (StorageInterestGroupAd -> Maybe Text
storageInterestGroupAdMetadata StorageInterestGroupAd
p)
    ]

-- | Type 'Storage.InterestGroupDetails'.
--   The full details of an interest group.
data StorageInterestGroupDetails = StorageInterestGroupDetails
  {
    StorageInterestGroupDetails -> Text
storageInterestGroupDetailsOwnerOrigin :: T.Text,
    StorageInterestGroupDetails -> Text
storageInterestGroupDetailsName :: T.Text,
    StorageInterestGroupDetails -> Double
storageInterestGroupDetailsExpirationTime :: DOMPageNetworkEmulationSecurity.NetworkTimeSinceEpoch,
    StorageInterestGroupDetails -> Text
storageInterestGroupDetailsJoiningOrigin :: T.Text,
    StorageInterestGroupDetails -> Maybe Text
storageInterestGroupDetailsBiddingUrl :: Maybe T.Text,
    StorageInterestGroupDetails -> Maybe Text
storageInterestGroupDetailsBiddingWasmHelperUrl :: Maybe T.Text,
    StorageInterestGroupDetails -> Maybe Text
storageInterestGroupDetailsUpdateUrl :: Maybe T.Text,
    StorageInterestGroupDetails -> Maybe Text
storageInterestGroupDetailsTrustedBiddingSignalsUrl :: Maybe T.Text,
    StorageInterestGroupDetails -> [Text]
storageInterestGroupDetailsTrustedBiddingSignalsKeys :: [T.Text],
    StorageInterestGroupDetails -> Maybe Text
storageInterestGroupDetailsUserBiddingSignals :: Maybe T.Text,
    StorageInterestGroupDetails -> [StorageInterestGroupAd]
storageInterestGroupDetailsAds :: [StorageInterestGroupAd],
    StorageInterestGroupDetails -> [StorageInterestGroupAd]
storageInterestGroupDetailsAdComponents :: [StorageInterestGroupAd]
  }
  deriving (StorageInterestGroupDetails -> StorageInterestGroupDetails -> Bool
(StorageInterestGroupDetails
 -> StorageInterestGroupDetails -> Bool)
-> (StorageInterestGroupDetails
    -> StorageInterestGroupDetails -> Bool)
-> Eq StorageInterestGroupDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageInterestGroupDetails -> StorageInterestGroupDetails -> Bool
$c/= :: StorageInterestGroupDetails -> StorageInterestGroupDetails -> Bool
== :: StorageInterestGroupDetails -> StorageInterestGroupDetails -> Bool
$c== :: StorageInterestGroupDetails -> StorageInterestGroupDetails -> Bool
Eq, Int -> StorageInterestGroupDetails -> ShowS
[StorageInterestGroupDetails] -> ShowS
StorageInterestGroupDetails -> String
(Int -> StorageInterestGroupDetails -> ShowS)
-> (StorageInterestGroupDetails -> String)
-> ([StorageInterestGroupDetails] -> ShowS)
-> Show StorageInterestGroupDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageInterestGroupDetails] -> ShowS
$cshowList :: [StorageInterestGroupDetails] -> ShowS
show :: StorageInterestGroupDetails -> String
$cshow :: StorageInterestGroupDetails -> String
showsPrec :: Int -> StorageInterestGroupDetails -> ShowS
$cshowsPrec :: Int -> StorageInterestGroupDetails -> ShowS
Show)
instance FromJSON StorageInterestGroupDetails where
  parseJSON :: Value -> Parser StorageInterestGroupDetails
parseJSON = String
-> (Object -> Parser StorageInterestGroupDetails)
-> Value
-> Parser StorageInterestGroupDetails
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageInterestGroupDetails" ((Object -> Parser StorageInterestGroupDetails)
 -> Value -> Parser StorageInterestGroupDetails)
-> (Object -> Parser StorageInterestGroupDetails)
-> Value
-> Parser StorageInterestGroupDetails
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Double
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [Text]
-> Maybe Text
-> [StorageInterestGroupAd]
-> [StorageInterestGroupAd]
-> StorageInterestGroupDetails
StorageInterestGroupDetails
    (Text
 -> Text
 -> Double
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> [Text]
 -> Maybe Text
 -> [StorageInterestGroupAd]
 -> [StorageInterestGroupAd]
 -> StorageInterestGroupDetails)
-> Parser Text
-> Parser
     (Text
      -> Double
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Text
      -> [StorageInterestGroupAd]
      -> [StorageInterestGroupAd]
      -> StorageInterestGroupDetails)
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
"ownerOrigin"
    Parser
  (Text
   -> Double
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Text
   -> [StorageInterestGroupAd]
   -> [StorageInterestGroupAd]
   -> StorageInterestGroupDetails)
-> Parser Text
-> Parser
     (Double
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Text
      -> [StorageInterestGroupAd]
      -> [StorageInterestGroupAd]
      -> StorageInterestGroupDetails)
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
"name"
    Parser
  (Double
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Text
   -> [StorageInterestGroupAd]
   -> [StorageInterestGroupAd]
   -> StorageInterestGroupDetails)
-> Parser Double
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Text
      -> [StorageInterestGroupAd]
      -> [StorageInterestGroupAd]
      -> StorageInterestGroupDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"expirationTime"
    Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Text
   -> [StorageInterestGroupAd]
   -> [StorageInterestGroupAd]
   -> StorageInterestGroupDetails)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Text
      -> [StorageInterestGroupAd]
      -> [StorageInterestGroupAd]
      -> StorageInterestGroupDetails)
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
"joiningOrigin"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Text
   -> [StorageInterestGroupAd]
   -> [StorageInterestGroupAd]
   -> StorageInterestGroupDetails)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Text
      -> [StorageInterestGroupAd]
      -> [StorageInterestGroupAd]
      -> StorageInterestGroupDetails)
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
"biddingUrl"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Text
   -> [StorageInterestGroupAd]
   -> [StorageInterestGroupAd]
   -> StorageInterestGroupDetails)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Text
      -> [StorageInterestGroupAd]
      -> [StorageInterestGroupAd]
      -> StorageInterestGroupDetails)
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
"biddingWasmHelperUrl"
    Parser
  (Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Text
   -> [StorageInterestGroupAd]
   -> [StorageInterestGroupAd]
   -> StorageInterestGroupDetails)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> [Text]
      -> Maybe Text
      -> [StorageInterestGroupAd]
      -> [StorageInterestGroupAd]
      -> StorageInterestGroupDetails)
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
"updateUrl"
    Parser
  (Maybe Text
   -> [Text]
   -> Maybe Text
   -> [StorageInterestGroupAd]
   -> [StorageInterestGroupAd]
   -> StorageInterestGroupDetails)
-> Parser (Maybe Text)
-> Parser
     ([Text]
      -> Maybe Text
      -> [StorageInterestGroupAd]
      -> [StorageInterestGroupAd]
      -> StorageInterestGroupDetails)
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
"trustedBiddingSignalsUrl"
    Parser
  ([Text]
   -> Maybe Text
   -> [StorageInterestGroupAd]
   -> [StorageInterestGroupAd]
   -> StorageInterestGroupDetails)
-> Parser [Text]
-> Parser
     (Maybe Text
      -> [StorageInterestGroupAd]
      -> [StorageInterestGroupAd]
      -> StorageInterestGroupDetails)
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
"trustedBiddingSignalsKeys"
    Parser
  (Maybe Text
   -> [StorageInterestGroupAd]
   -> [StorageInterestGroupAd]
   -> StorageInterestGroupDetails)
-> Parser (Maybe Text)
-> Parser
     ([StorageInterestGroupAd]
      -> [StorageInterestGroupAd] -> StorageInterestGroupDetails)
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
"userBiddingSignals"
    Parser
  ([StorageInterestGroupAd]
   -> [StorageInterestGroupAd] -> StorageInterestGroupDetails)
-> Parser [StorageInterestGroupAd]
-> Parser ([StorageInterestGroupAd] -> StorageInterestGroupDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [StorageInterestGroupAd]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"ads"
    Parser ([StorageInterestGroupAd] -> StorageInterestGroupDetails)
-> Parser [StorageInterestGroupAd]
-> Parser StorageInterestGroupDetails
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [StorageInterestGroupAd]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"adComponents"
instance ToJSON StorageInterestGroupDetails where
  toJSON :: StorageInterestGroupDetails -> Value
toJSON StorageInterestGroupDetails
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
"ownerOrigin" 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 (StorageInterestGroupDetails -> Text
storageInterestGroupDetailsOwnerOrigin StorageInterestGroupDetails
p),
    (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 (StorageInterestGroupDetails -> Text
storageInterestGroupDetailsName StorageInterestGroupDetails
p),
    (Text
"expirationTime" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (StorageInterestGroupDetails -> Double
storageInterestGroupDetailsExpirationTime StorageInterestGroupDetails
p),
    (Text
"joiningOrigin" 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 (StorageInterestGroupDetails -> Text
storageInterestGroupDetailsJoiningOrigin StorageInterestGroupDetails
p),
    (Text
"biddingUrl" 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
<$> (StorageInterestGroupDetails -> Maybe Text
storageInterestGroupDetailsBiddingUrl StorageInterestGroupDetails
p),
    (Text
"biddingWasmHelperUrl" 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
<$> (StorageInterestGroupDetails -> Maybe Text
storageInterestGroupDetailsBiddingWasmHelperUrl StorageInterestGroupDetails
p),
    (Text
"updateUrl" 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
<$> (StorageInterestGroupDetails -> Maybe Text
storageInterestGroupDetailsUpdateUrl StorageInterestGroupDetails
p),
    (Text
"trustedBiddingSignalsUrl" 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
<$> (StorageInterestGroupDetails -> Maybe Text
storageInterestGroupDetailsTrustedBiddingSignalsUrl StorageInterestGroupDetails
p),
    (Text
"trustedBiddingSignalsKeys" 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 (StorageInterestGroupDetails -> [Text]
storageInterestGroupDetailsTrustedBiddingSignalsKeys StorageInterestGroupDetails
p),
    (Text
"userBiddingSignals" 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
<$> (StorageInterestGroupDetails -> Maybe Text
storageInterestGroupDetailsUserBiddingSignals StorageInterestGroupDetails
p),
    (Text
"ads" Text -> [StorageInterestGroupAd] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([StorageInterestGroupAd] -> Pair)
-> Maybe [StorageInterestGroupAd] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StorageInterestGroupAd] -> Maybe [StorageInterestGroupAd]
forall a. a -> Maybe a
Just (StorageInterestGroupDetails -> [StorageInterestGroupAd]
storageInterestGroupDetailsAds StorageInterestGroupDetails
p),
    (Text
"adComponents" Text -> [StorageInterestGroupAd] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([StorageInterestGroupAd] -> Pair)
-> Maybe [StorageInterestGroupAd] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StorageInterestGroupAd] -> Maybe [StorageInterestGroupAd]
forall a. a -> Maybe a
Just (StorageInterestGroupDetails -> [StorageInterestGroupAd]
storageInterestGroupDetailsAdComponents StorageInterestGroupDetails
p)
    ]

-- | Type of the 'Storage.cacheStorageContentUpdated' event.
data StorageCacheStorageContentUpdated = StorageCacheStorageContentUpdated
  {
    -- | Origin to update.
    StorageCacheStorageContentUpdated -> Text
storageCacheStorageContentUpdatedOrigin :: T.Text,
    -- | Name of cache in origin.
    StorageCacheStorageContentUpdated -> Text
storageCacheStorageContentUpdatedCacheName :: T.Text
  }
  deriving (StorageCacheStorageContentUpdated
-> StorageCacheStorageContentUpdated -> Bool
(StorageCacheStorageContentUpdated
 -> StorageCacheStorageContentUpdated -> Bool)
-> (StorageCacheStorageContentUpdated
    -> StorageCacheStorageContentUpdated -> Bool)
-> Eq StorageCacheStorageContentUpdated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageCacheStorageContentUpdated
-> StorageCacheStorageContentUpdated -> Bool
$c/= :: StorageCacheStorageContentUpdated
-> StorageCacheStorageContentUpdated -> Bool
== :: StorageCacheStorageContentUpdated
-> StorageCacheStorageContentUpdated -> Bool
$c== :: StorageCacheStorageContentUpdated
-> StorageCacheStorageContentUpdated -> Bool
Eq, Int -> StorageCacheStorageContentUpdated -> ShowS
[StorageCacheStorageContentUpdated] -> ShowS
StorageCacheStorageContentUpdated -> String
(Int -> StorageCacheStorageContentUpdated -> ShowS)
-> (StorageCacheStorageContentUpdated -> String)
-> ([StorageCacheStorageContentUpdated] -> ShowS)
-> Show StorageCacheStorageContentUpdated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageCacheStorageContentUpdated] -> ShowS
$cshowList :: [StorageCacheStorageContentUpdated] -> ShowS
show :: StorageCacheStorageContentUpdated -> String
$cshow :: StorageCacheStorageContentUpdated -> String
showsPrec :: Int -> StorageCacheStorageContentUpdated -> ShowS
$cshowsPrec :: Int -> StorageCacheStorageContentUpdated -> ShowS
Show)
instance FromJSON StorageCacheStorageContentUpdated where
  parseJSON :: Value -> Parser StorageCacheStorageContentUpdated
parseJSON = String
-> (Object -> Parser StorageCacheStorageContentUpdated)
-> Value
-> Parser StorageCacheStorageContentUpdated
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageCacheStorageContentUpdated" ((Object -> Parser StorageCacheStorageContentUpdated)
 -> Value -> Parser StorageCacheStorageContentUpdated)
-> (Object -> Parser StorageCacheStorageContentUpdated)
-> Value
-> Parser StorageCacheStorageContentUpdated
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> StorageCacheStorageContentUpdated
StorageCacheStorageContentUpdated
    (Text -> Text -> StorageCacheStorageContentUpdated)
-> Parser Text
-> Parser (Text -> StorageCacheStorageContentUpdated)
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
"origin"
    Parser (Text -> StorageCacheStorageContentUpdated)
-> Parser Text -> Parser StorageCacheStorageContentUpdated
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
"cacheName"
instance Event StorageCacheStorageContentUpdated where
  eventName :: Proxy StorageCacheStorageContentUpdated -> String
eventName Proxy StorageCacheStorageContentUpdated
_ = String
"Storage.cacheStorageContentUpdated"

-- | Type of the 'Storage.cacheStorageListUpdated' event.
data StorageCacheStorageListUpdated = StorageCacheStorageListUpdated
  {
    -- | Origin to update.
    StorageCacheStorageListUpdated -> Text
storageCacheStorageListUpdatedOrigin :: T.Text
  }
  deriving (StorageCacheStorageListUpdated
-> StorageCacheStorageListUpdated -> Bool
(StorageCacheStorageListUpdated
 -> StorageCacheStorageListUpdated -> Bool)
-> (StorageCacheStorageListUpdated
    -> StorageCacheStorageListUpdated -> Bool)
-> Eq StorageCacheStorageListUpdated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageCacheStorageListUpdated
-> StorageCacheStorageListUpdated -> Bool
$c/= :: StorageCacheStorageListUpdated
-> StorageCacheStorageListUpdated -> Bool
== :: StorageCacheStorageListUpdated
-> StorageCacheStorageListUpdated -> Bool
$c== :: StorageCacheStorageListUpdated
-> StorageCacheStorageListUpdated -> Bool
Eq, Int -> StorageCacheStorageListUpdated -> ShowS
[StorageCacheStorageListUpdated] -> ShowS
StorageCacheStorageListUpdated -> String
(Int -> StorageCacheStorageListUpdated -> ShowS)
-> (StorageCacheStorageListUpdated -> String)
-> ([StorageCacheStorageListUpdated] -> ShowS)
-> Show StorageCacheStorageListUpdated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageCacheStorageListUpdated] -> ShowS
$cshowList :: [StorageCacheStorageListUpdated] -> ShowS
show :: StorageCacheStorageListUpdated -> String
$cshow :: StorageCacheStorageListUpdated -> String
showsPrec :: Int -> StorageCacheStorageListUpdated -> ShowS
$cshowsPrec :: Int -> StorageCacheStorageListUpdated -> ShowS
Show)
instance FromJSON StorageCacheStorageListUpdated where
  parseJSON :: Value -> Parser StorageCacheStorageListUpdated
parseJSON = String
-> (Object -> Parser StorageCacheStorageListUpdated)
-> Value
-> Parser StorageCacheStorageListUpdated
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageCacheStorageListUpdated" ((Object -> Parser StorageCacheStorageListUpdated)
 -> Value -> Parser StorageCacheStorageListUpdated)
-> (Object -> Parser StorageCacheStorageListUpdated)
-> Value
-> Parser StorageCacheStorageListUpdated
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> StorageCacheStorageListUpdated
StorageCacheStorageListUpdated
    (Text -> StorageCacheStorageListUpdated)
-> Parser Text -> Parser StorageCacheStorageListUpdated
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
"origin"
instance Event StorageCacheStorageListUpdated where
  eventName :: Proxy StorageCacheStorageListUpdated -> String
eventName Proxy StorageCacheStorageListUpdated
_ = String
"Storage.cacheStorageListUpdated"

-- | Type of the 'Storage.indexedDBContentUpdated' event.
data StorageIndexedDBContentUpdated = StorageIndexedDBContentUpdated
  {
    -- | Origin to update.
    StorageIndexedDBContentUpdated -> Text
storageIndexedDBContentUpdatedOrigin :: T.Text,
    -- | Storage key to update.
    StorageIndexedDBContentUpdated -> Text
storageIndexedDBContentUpdatedStorageKey :: T.Text,
    -- | Database to update.
    StorageIndexedDBContentUpdated -> Text
storageIndexedDBContentUpdatedDatabaseName :: T.Text,
    -- | ObjectStore to update.
    StorageIndexedDBContentUpdated -> Text
storageIndexedDBContentUpdatedObjectStoreName :: T.Text
  }
  deriving (StorageIndexedDBContentUpdated
-> StorageIndexedDBContentUpdated -> Bool
(StorageIndexedDBContentUpdated
 -> StorageIndexedDBContentUpdated -> Bool)
-> (StorageIndexedDBContentUpdated
    -> StorageIndexedDBContentUpdated -> Bool)
-> Eq StorageIndexedDBContentUpdated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageIndexedDBContentUpdated
-> StorageIndexedDBContentUpdated -> Bool
$c/= :: StorageIndexedDBContentUpdated
-> StorageIndexedDBContentUpdated -> Bool
== :: StorageIndexedDBContentUpdated
-> StorageIndexedDBContentUpdated -> Bool
$c== :: StorageIndexedDBContentUpdated
-> StorageIndexedDBContentUpdated -> Bool
Eq, Int -> StorageIndexedDBContentUpdated -> ShowS
[StorageIndexedDBContentUpdated] -> ShowS
StorageIndexedDBContentUpdated -> String
(Int -> StorageIndexedDBContentUpdated -> ShowS)
-> (StorageIndexedDBContentUpdated -> String)
-> ([StorageIndexedDBContentUpdated] -> ShowS)
-> Show StorageIndexedDBContentUpdated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageIndexedDBContentUpdated] -> ShowS
$cshowList :: [StorageIndexedDBContentUpdated] -> ShowS
show :: StorageIndexedDBContentUpdated -> String
$cshow :: StorageIndexedDBContentUpdated -> String
showsPrec :: Int -> StorageIndexedDBContentUpdated -> ShowS
$cshowsPrec :: Int -> StorageIndexedDBContentUpdated -> ShowS
Show)
instance FromJSON StorageIndexedDBContentUpdated where
  parseJSON :: Value -> Parser StorageIndexedDBContentUpdated
parseJSON = String
-> (Object -> Parser StorageIndexedDBContentUpdated)
-> Value
-> Parser StorageIndexedDBContentUpdated
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageIndexedDBContentUpdated" ((Object -> Parser StorageIndexedDBContentUpdated)
 -> Value -> Parser StorageIndexedDBContentUpdated)
-> (Object -> Parser StorageIndexedDBContentUpdated)
-> Value
-> Parser StorageIndexedDBContentUpdated
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Text -> Text -> StorageIndexedDBContentUpdated
StorageIndexedDBContentUpdated
    (Text -> Text -> Text -> Text -> StorageIndexedDBContentUpdated)
-> Parser Text
-> Parser (Text -> Text -> Text -> StorageIndexedDBContentUpdated)
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
"origin"
    Parser (Text -> Text -> Text -> StorageIndexedDBContentUpdated)
-> Parser Text
-> Parser (Text -> Text -> StorageIndexedDBContentUpdated)
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
"storageKey"
    Parser (Text -> Text -> StorageIndexedDBContentUpdated)
-> Parser Text -> Parser (Text -> StorageIndexedDBContentUpdated)
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
"databaseName"
    Parser (Text -> StorageIndexedDBContentUpdated)
-> Parser Text -> Parser StorageIndexedDBContentUpdated
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
"objectStoreName"
instance Event StorageIndexedDBContentUpdated where
  eventName :: Proxy StorageIndexedDBContentUpdated -> String
eventName Proxy StorageIndexedDBContentUpdated
_ = String
"Storage.indexedDBContentUpdated"

-- | Type of the 'Storage.indexedDBListUpdated' event.
data StorageIndexedDBListUpdated = StorageIndexedDBListUpdated
  {
    -- | Origin to update.
    StorageIndexedDBListUpdated -> Text
storageIndexedDBListUpdatedOrigin :: T.Text,
    -- | Storage key to update.
    StorageIndexedDBListUpdated -> Text
storageIndexedDBListUpdatedStorageKey :: T.Text
  }
  deriving (StorageIndexedDBListUpdated -> StorageIndexedDBListUpdated -> Bool
(StorageIndexedDBListUpdated
 -> StorageIndexedDBListUpdated -> Bool)
-> (StorageIndexedDBListUpdated
    -> StorageIndexedDBListUpdated -> Bool)
-> Eq StorageIndexedDBListUpdated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageIndexedDBListUpdated -> StorageIndexedDBListUpdated -> Bool
$c/= :: StorageIndexedDBListUpdated -> StorageIndexedDBListUpdated -> Bool
== :: StorageIndexedDBListUpdated -> StorageIndexedDBListUpdated -> Bool
$c== :: StorageIndexedDBListUpdated -> StorageIndexedDBListUpdated -> Bool
Eq, Int -> StorageIndexedDBListUpdated -> ShowS
[StorageIndexedDBListUpdated] -> ShowS
StorageIndexedDBListUpdated -> String
(Int -> StorageIndexedDBListUpdated -> ShowS)
-> (StorageIndexedDBListUpdated -> String)
-> ([StorageIndexedDBListUpdated] -> ShowS)
-> Show StorageIndexedDBListUpdated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageIndexedDBListUpdated] -> ShowS
$cshowList :: [StorageIndexedDBListUpdated] -> ShowS
show :: StorageIndexedDBListUpdated -> String
$cshow :: StorageIndexedDBListUpdated -> String
showsPrec :: Int -> StorageIndexedDBListUpdated -> ShowS
$cshowsPrec :: Int -> StorageIndexedDBListUpdated -> ShowS
Show)
instance FromJSON StorageIndexedDBListUpdated where
  parseJSON :: Value -> Parser StorageIndexedDBListUpdated
parseJSON = String
-> (Object -> Parser StorageIndexedDBListUpdated)
-> Value
-> Parser StorageIndexedDBListUpdated
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageIndexedDBListUpdated" ((Object -> Parser StorageIndexedDBListUpdated)
 -> Value -> Parser StorageIndexedDBListUpdated)
-> (Object -> Parser StorageIndexedDBListUpdated)
-> Value
-> Parser StorageIndexedDBListUpdated
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> StorageIndexedDBListUpdated
StorageIndexedDBListUpdated
    (Text -> Text -> StorageIndexedDBListUpdated)
-> Parser Text -> Parser (Text -> StorageIndexedDBListUpdated)
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
"origin"
    Parser (Text -> StorageIndexedDBListUpdated)
-> Parser Text -> Parser StorageIndexedDBListUpdated
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
"storageKey"
instance Event StorageIndexedDBListUpdated where
  eventName :: Proxy StorageIndexedDBListUpdated -> String
eventName Proxy StorageIndexedDBListUpdated
_ = String
"Storage.indexedDBListUpdated"

-- | Type of the 'Storage.interestGroupAccessed' event.
data StorageInterestGroupAccessed = StorageInterestGroupAccessed
  {
    StorageInterestGroupAccessed -> Double
storageInterestGroupAccessedAccessTime :: DOMPageNetworkEmulationSecurity.NetworkTimeSinceEpoch,
    StorageInterestGroupAccessed -> StorageInterestGroupAccessType
storageInterestGroupAccessedType :: StorageInterestGroupAccessType,
    StorageInterestGroupAccessed -> Text
storageInterestGroupAccessedOwnerOrigin :: T.Text,
    StorageInterestGroupAccessed -> Text
storageInterestGroupAccessedName :: T.Text
  }
  deriving (StorageInterestGroupAccessed
-> StorageInterestGroupAccessed -> Bool
(StorageInterestGroupAccessed
 -> StorageInterestGroupAccessed -> Bool)
-> (StorageInterestGroupAccessed
    -> StorageInterestGroupAccessed -> Bool)
-> Eq StorageInterestGroupAccessed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageInterestGroupAccessed
-> StorageInterestGroupAccessed -> Bool
$c/= :: StorageInterestGroupAccessed
-> StorageInterestGroupAccessed -> Bool
== :: StorageInterestGroupAccessed
-> StorageInterestGroupAccessed -> Bool
$c== :: StorageInterestGroupAccessed
-> StorageInterestGroupAccessed -> Bool
Eq, Int -> StorageInterestGroupAccessed -> ShowS
[StorageInterestGroupAccessed] -> ShowS
StorageInterestGroupAccessed -> String
(Int -> StorageInterestGroupAccessed -> ShowS)
-> (StorageInterestGroupAccessed -> String)
-> ([StorageInterestGroupAccessed] -> ShowS)
-> Show StorageInterestGroupAccessed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageInterestGroupAccessed] -> ShowS
$cshowList :: [StorageInterestGroupAccessed] -> ShowS
show :: StorageInterestGroupAccessed -> String
$cshow :: StorageInterestGroupAccessed -> String
showsPrec :: Int -> StorageInterestGroupAccessed -> ShowS
$cshowsPrec :: Int -> StorageInterestGroupAccessed -> ShowS
Show)
instance FromJSON StorageInterestGroupAccessed where
  parseJSON :: Value -> Parser StorageInterestGroupAccessed
parseJSON = String
-> (Object -> Parser StorageInterestGroupAccessed)
-> Value
-> Parser StorageInterestGroupAccessed
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageInterestGroupAccessed" ((Object -> Parser StorageInterestGroupAccessed)
 -> Value -> Parser StorageInterestGroupAccessed)
-> (Object -> Parser StorageInterestGroupAccessed)
-> Value
-> Parser StorageInterestGroupAccessed
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double
-> StorageInterestGroupAccessType
-> Text
-> Text
-> StorageInterestGroupAccessed
StorageInterestGroupAccessed
    (Double
 -> StorageInterestGroupAccessType
 -> Text
 -> Text
 -> StorageInterestGroupAccessed)
-> Parser Double
-> Parser
     (StorageInterestGroupAccessType
      -> Text -> Text -> StorageInterestGroupAccessed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"accessTime"
    Parser
  (StorageInterestGroupAccessType
   -> Text -> Text -> StorageInterestGroupAccessed)
-> Parser StorageInterestGroupAccessType
-> Parser (Text -> Text -> StorageInterestGroupAccessed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser StorageInterestGroupAccessType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Parser (Text -> Text -> StorageInterestGroupAccessed)
-> Parser Text -> Parser (Text -> StorageInterestGroupAccessed)
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
"ownerOrigin"
    Parser (Text -> StorageInterestGroupAccessed)
-> Parser Text -> Parser StorageInterestGroupAccessed
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
"name"
instance Event StorageInterestGroupAccessed where
  eventName :: Proxy StorageInterestGroupAccessed -> String
eventName Proxy StorageInterestGroupAccessed
_ = String
"Storage.interestGroupAccessed"

-- | Returns a storage key given a frame id.

-- | Parameters of the 'Storage.getStorageKeyForFrame' command.
data PStorageGetStorageKeyForFrame = PStorageGetStorageKeyForFrame
  {
    PStorageGetStorageKeyForFrame -> Text
pStorageGetStorageKeyForFrameFrameId :: DOMPageNetworkEmulationSecurity.PageFrameId
  }
  deriving (PStorageGetStorageKeyForFrame
-> PStorageGetStorageKeyForFrame -> Bool
(PStorageGetStorageKeyForFrame
 -> PStorageGetStorageKeyForFrame -> Bool)
-> (PStorageGetStorageKeyForFrame
    -> PStorageGetStorageKeyForFrame -> Bool)
-> Eq PStorageGetStorageKeyForFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageGetStorageKeyForFrame
-> PStorageGetStorageKeyForFrame -> Bool
$c/= :: PStorageGetStorageKeyForFrame
-> PStorageGetStorageKeyForFrame -> Bool
== :: PStorageGetStorageKeyForFrame
-> PStorageGetStorageKeyForFrame -> Bool
$c== :: PStorageGetStorageKeyForFrame
-> PStorageGetStorageKeyForFrame -> Bool
Eq, Int -> PStorageGetStorageKeyForFrame -> ShowS
[PStorageGetStorageKeyForFrame] -> ShowS
PStorageGetStorageKeyForFrame -> String
(Int -> PStorageGetStorageKeyForFrame -> ShowS)
-> (PStorageGetStorageKeyForFrame -> String)
-> ([PStorageGetStorageKeyForFrame] -> ShowS)
-> Show PStorageGetStorageKeyForFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageGetStorageKeyForFrame] -> ShowS
$cshowList :: [PStorageGetStorageKeyForFrame] -> ShowS
show :: PStorageGetStorageKeyForFrame -> String
$cshow :: PStorageGetStorageKeyForFrame -> String
showsPrec :: Int -> PStorageGetStorageKeyForFrame -> ShowS
$cshowsPrec :: Int -> PStorageGetStorageKeyForFrame -> ShowS
Show)
pStorageGetStorageKeyForFrame
  :: DOMPageNetworkEmulationSecurity.PageFrameId
  -> PStorageGetStorageKeyForFrame
pStorageGetStorageKeyForFrame :: Text -> PStorageGetStorageKeyForFrame
pStorageGetStorageKeyForFrame
  Text
arg_pStorageGetStorageKeyForFrameFrameId
  = Text -> PStorageGetStorageKeyForFrame
PStorageGetStorageKeyForFrame
    Text
arg_pStorageGetStorageKeyForFrameFrameId
instance ToJSON PStorageGetStorageKeyForFrame where
  toJSON :: PStorageGetStorageKeyForFrame -> Value
toJSON PStorageGetStorageKeyForFrame
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
"frameId" 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 (PStorageGetStorageKeyForFrame -> Text
pStorageGetStorageKeyForFrameFrameId PStorageGetStorageKeyForFrame
p)
    ]
data StorageGetStorageKeyForFrame = StorageGetStorageKeyForFrame
  {
    StorageGetStorageKeyForFrame -> Text
storageGetStorageKeyForFrameStorageKey :: StorageSerializedStorageKey
  }
  deriving (StorageGetStorageKeyForFrame
-> StorageGetStorageKeyForFrame -> Bool
(StorageGetStorageKeyForFrame
 -> StorageGetStorageKeyForFrame -> Bool)
-> (StorageGetStorageKeyForFrame
    -> StorageGetStorageKeyForFrame -> Bool)
-> Eq StorageGetStorageKeyForFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageGetStorageKeyForFrame
-> StorageGetStorageKeyForFrame -> Bool
$c/= :: StorageGetStorageKeyForFrame
-> StorageGetStorageKeyForFrame -> Bool
== :: StorageGetStorageKeyForFrame
-> StorageGetStorageKeyForFrame -> Bool
$c== :: StorageGetStorageKeyForFrame
-> StorageGetStorageKeyForFrame -> Bool
Eq, Int -> StorageGetStorageKeyForFrame -> ShowS
[StorageGetStorageKeyForFrame] -> ShowS
StorageGetStorageKeyForFrame -> String
(Int -> StorageGetStorageKeyForFrame -> ShowS)
-> (StorageGetStorageKeyForFrame -> String)
-> ([StorageGetStorageKeyForFrame] -> ShowS)
-> Show StorageGetStorageKeyForFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageGetStorageKeyForFrame] -> ShowS
$cshowList :: [StorageGetStorageKeyForFrame] -> ShowS
show :: StorageGetStorageKeyForFrame -> String
$cshow :: StorageGetStorageKeyForFrame -> String
showsPrec :: Int -> StorageGetStorageKeyForFrame -> ShowS
$cshowsPrec :: Int -> StorageGetStorageKeyForFrame -> ShowS
Show)
instance FromJSON StorageGetStorageKeyForFrame where
  parseJSON :: Value -> Parser StorageGetStorageKeyForFrame
parseJSON = String
-> (Object -> Parser StorageGetStorageKeyForFrame)
-> Value
-> Parser StorageGetStorageKeyForFrame
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageGetStorageKeyForFrame" ((Object -> Parser StorageGetStorageKeyForFrame)
 -> Value -> Parser StorageGetStorageKeyForFrame)
-> (Object -> Parser StorageGetStorageKeyForFrame)
-> Value
-> Parser StorageGetStorageKeyForFrame
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> StorageGetStorageKeyForFrame
StorageGetStorageKeyForFrame
    (Text -> StorageGetStorageKeyForFrame)
-> Parser Text -> Parser StorageGetStorageKeyForFrame
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
"storageKey"
instance Command PStorageGetStorageKeyForFrame where
  type CommandResponse PStorageGetStorageKeyForFrame = StorageGetStorageKeyForFrame
  commandName :: Proxy PStorageGetStorageKeyForFrame -> String
commandName Proxy PStorageGetStorageKeyForFrame
_ = String
"Storage.getStorageKeyForFrame"

-- | Clears storage for origin.

-- | Parameters of the 'Storage.clearDataForOrigin' command.
data PStorageClearDataForOrigin = PStorageClearDataForOrigin
  {
    -- | Security origin.
    PStorageClearDataForOrigin -> Text
pStorageClearDataForOriginOrigin :: T.Text,
    -- | Comma separated list of StorageType to clear.
    PStorageClearDataForOrigin -> Text
pStorageClearDataForOriginStorageTypes :: T.Text
  }
  deriving (PStorageClearDataForOrigin -> PStorageClearDataForOrigin -> Bool
(PStorageClearDataForOrigin -> PStorageClearDataForOrigin -> Bool)
-> (PStorageClearDataForOrigin
    -> PStorageClearDataForOrigin -> Bool)
-> Eq PStorageClearDataForOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageClearDataForOrigin -> PStorageClearDataForOrigin -> Bool
$c/= :: PStorageClearDataForOrigin -> PStorageClearDataForOrigin -> Bool
== :: PStorageClearDataForOrigin -> PStorageClearDataForOrigin -> Bool
$c== :: PStorageClearDataForOrigin -> PStorageClearDataForOrigin -> Bool
Eq, Int -> PStorageClearDataForOrigin -> ShowS
[PStorageClearDataForOrigin] -> ShowS
PStorageClearDataForOrigin -> String
(Int -> PStorageClearDataForOrigin -> ShowS)
-> (PStorageClearDataForOrigin -> String)
-> ([PStorageClearDataForOrigin] -> ShowS)
-> Show PStorageClearDataForOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageClearDataForOrigin] -> ShowS
$cshowList :: [PStorageClearDataForOrigin] -> ShowS
show :: PStorageClearDataForOrigin -> String
$cshow :: PStorageClearDataForOrigin -> String
showsPrec :: Int -> PStorageClearDataForOrigin -> ShowS
$cshowsPrec :: Int -> PStorageClearDataForOrigin -> ShowS
Show)
pStorageClearDataForOrigin
  {-
  -- | Security origin.
  -}
  :: T.Text
  {-
  -- | Comma separated list of StorageType to clear.
  -}
  -> T.Text
  -> PStorageClearDataForOrigin
pStorageClearDataForOrigin :: Text -> Text -> PStorageClearDataForOrigin
pStorageClearDataForOrigin
  Text
arg_pStorageClearDataForOriginOrigin
  Text
arg_pStorageClearDataForOriginStorageTypes
  = Text -> Text -> PStorageClearDataForOrigin
PStorageClearDataForOrigin
    Text
arg_pStorageClearDataForOriginOrigin
    Text
arg_pStorageClearDataForOriginStorageTypes
instance ToJSON PStorageClearDataForOrigin where
  toJSON :: PStorageClearDataForOrigin -> Value
toJSON PStorageClearDataForOrigin
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
"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 (PStorageClearDataForOrigin -> Text
pStorageClearDataForOriginOrigin PStorageClearDataForOrigin
p),
    (Text
"storageTypes" 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 (PStorageClearDataForOrigin -> Text
pStorageClearDataForOriginStorageTypes PStorageClearDataForOrigin
p)
    ]
instance Command PStorageClearDataForOrigin where
  type CommandResponse PStorageClearDataForOrigin = ()
  commandName :: Proxy PStorageClearDataForOrigin -> String
commandName Proxy PStorageClearDataForOrigin
_ = String
"Storage.clearDataForOrigin"
  fromJSON :: Proxy PStorageClearDataForOrigin
-> Value -> Result (CommandResponse PStorageClearDataForOrigin)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageClearDataForOrigin -> Result ())
-> Proxy PStorageClearDataForOrigin
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageClearDataForOrigin -> ())
-> Proxy PStorageClearDataForOrigin
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageClearDataForOrigin -> ()
forall a b. a -> b -> a
const ()

-- | Clears storage for storage key.

-- | Parameters of the 'Storage.clearDataForStorageKey' command.
data PStorageClearDataForStorageKey = PStorageClearDataForStorageKey
  {
    -- | Storage key.
    PStorageClearDataForStorageKey -> Text
pStorageClearDataForStorageKeyStorageKey :: T.Text,
    -- | Comma separated list of StorageType to clear.
    PStorageClearDataForStorageKey -> Text
pStorageClearDataForStorageKeyStorageTypes :: T.Text
  }
  deriving (PStorageClearDataForStorageKey
-> PStorageClearDataForStorageKey -> Bool
(PStorageClearDataForStorageKey
 -> PStorageClearDataForStorageKey -> Bool)
-> (PStorageClearDataForStorageKey
    -> PStorageClearDataForStorageKey -> Bool)
-> Eq PStorageClearDataForStorageKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageClearDataForStorageKey
-> PStorageClearDataForStorageKey -> Bool
$c/= :: PStorageClearDataForStorageKey
-> PStorageClearDataForStorageKey -> Bool
== :: PStorageClearDataForStorageKey
-> PStorageClearDataForStorageKey -> Bool
$c== :: PStorageClearDataForStorageKey
-> PStorageClearDataForStorageKey -> Bool
Eq, Int -> PStorageClearDataForStorageKey -> ShowS
[PStorageClearDataForStorageKey] -> ShowS
PStorageClearDataForStorageKey -> String
(Int -> PStorageClearDataForStorageKey -> ShowS)
-> (PStorageClearDataForStorageKey -> String)
-> ([PStorageClearDataForStorageKey] -> ShowS)
-> Show PStorageClearDataForStorageKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageClearDataForStorageKey] -> ShowS
$cshowList :: [PStorageClearDataForStorageKey] -> ShowS
show :: PStorageClearDataForStorageKey -> String
$cshow :: PStorageClearDataForStorageKey -> String
showsPrec :: Int -> PStorageClearDataForStorageKey -> ShowS
$cshowsPrec :: Int -> PStorageClearDataForStorageKey -> ShowS
Show)
pStorageClearDataForStorageKey
  {-
  -- | Storage key.
  -}
  :: T.Text
  {-
  -- | Comma separated list of StorageType to clear.
  -}
  -> T.Text
  -> PStorageClearDataForStorageKey
pStorageClearDataForStorageKey :: Text -> Text -> PStorageClearDataForStorageKey
pStorageClearDataForStorageKey
  Text
arg_pStorageClearDataForStorageKeyStorageKey
  Text
arg_pStorageClearDataForStorageKeyStorageTypes
  = Text -> Text -> PStorageClearDataForStorageKey
PStorageClearDataForStorageKey
    Text
arg_pStorageClearDataForStorageKeyStorageKey
    Text
arg_pStorageClearDataForStorageKeyStorageTypes
instance ToJSON PStorageClearDataForStorageKey where
  toJSON :: PStorageClearDataForStorageKey -> Value
toJSON PStorageClearDataForStorageKey
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
"storageKey" 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 (PStorageClearDataForStorageKey -> Text
pStorageClearDataForStorageKeyStorageKey PStorageClearDataForStorageKey
p),
    (Text
"storageTypes" 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 (PStorageClearDataForStorageKey -> Text
pStorageClearDataForStorageKeyStorageTypes PStorageClearDataForStorageKey
p)
    ]
instance Command PStorageClearDataForStorageKey where
  type CommandResponse PStorageClearDataForStorageKey = ()
  commandName :: Proxy PStorageClearDataForStorageKey -> String
commandName Proxy PStorageClearDataForStorageKey
_ = String
"Storage.clearDataForStorageKey"
  fromJSON :: Proxy PStorageClearDataForStorageKey
-> Value -> Result (CommandResponse PStorageClearDataForStorageKey)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageClearDataForStorageKey -> Result ())
-> Proxy PStorageClearDataForStorageKey
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageClearDataForStorageKey -> ())
-> Proxy PStorageClearDataForStorageKey
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageClearDataForStorageKey -> ()
forall a b. a -> b -> a
const ()

-- | Returns all browser cookies.

-- | Parameters of the 'Storage.getCookies' command.
data PStorageGetCookies = PStorageGetCookies
  {
    -- | Browser context to use when called on the browser endpoint.
    PStorageGetCookies -> Maybe Text
pStorageGetCookiesBrowserContextId :: Maybe BrowserTarget.BrowserBrowserContextID
  }
  deriving (PStorageGetCookies -> PStorageGetCookies -> Bool
(PStorageGetCookies -> PStorageGetCookies -> Bool)
-> (PStorageGetCookies -> PStorageGetCookies -> Bool)
-> Eq PStorageGetCookies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageGetCookies -> PStorageGetCookies -> Bool
$c/= :: PStorageGetCookies -> PStorageGetCookies -> Bool
== :: PStorageGetCookies -> PStorageGetCookies -> Bool
$c== :: PStorageGetCookies -> PStorageGetCookies -> Bool
Eq, Int -> PStorageGetCookies -> ShowS
[PStorageGetCookies] -> ShowS
PStorageGetCookies -> String
(Int -> PStorageGetCookies -> ShowS)
-> (PStorageGetCookies -> String)
-> ([PStorageGetCookies] -> ShowS)
-> Show PStorageGetCookies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageGetCookies] -> ShowS
$cshowList :: [PStorageGetCookies] -> ShowS
show :: PStorageGetCookies -> String
$cshow :: PStorageGetCookies -> String
showsPrec :: Int -> PStorageGetCookies -> ShowS
$cshowsPrec :: Int -> PStorageGetCookies -> ShowS
Show)
pStorageGetCookies
  :: PStorageGetCookies
pStorageGetCookies :: PStorageGetCookies
pStorageGetCookies
  = Maybe Text -> PStorageGetCookies
PStorageGetCookies
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PStorageGetCookies where
  toJSON :: PStorageGetCookies -> Value
toJSON PStorageGetCookies
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
"browserContextId" 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
<$> (PStorageGetCookies -> Maybe Text
pStorageGetCookiesBrowserContextId PStorageGetCookies
p)
    ]
data StorageGetCookies = StorageGetCookies
  {
    -- | Array of cookie objects.
    StorageGetCookies -> [NetworkCookie]
storageGetCookiesCookies :: [DOMPageNetworkEmulationSecurity.NetworkCookie]
  }
  deriving (StorageGetCookies -> StorageGetCookies -> Bool
(StorageGetCookies -> StorageGetCookies -> Bool)
-> (StorageGetCookies -> StorageGetCookies -> Bool)
-> Eq StorageGetCookies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageGetCookies -> StorageGetCookies -> Bool
$c/= :: StorageGetCookies -> StorageGetCookies -> Bool
== :: StorageGetCookies -> StorageGetCookies -> Bool
$c== :: StorageGetCookies -> StorageGetCookies -> Bool
Eq, Int -> StorageGetCookies -> ShowS
[StorageGetCookies] -> ShowS
StorageGetCookies -> String
(Int -> StorageGetCookies -> ShowS)
-> (StorageGetCookies -> String)
-> ([StorageGetCookies] -> ShowS)
-> Show StorageGetCookies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageGetCookies] -> ShowS
$cshowList :: [StorageGetCookies] -> ShowS
show :: StorageGetCookies -> String
$cshow :: StorageGetCookies -> String
showsPrec :: Int -> StorageGetCookies -> ShowS
$cshowsPrec :: Int -> StorageGetCookies -> ShowS
Show)
instance FromJSON StorageGetCookies where
  parseJSON :: Value -> Parser StorageGetCookies
parseJSON = String
-> (Object -> Parser StorageGetCookies)
-> Value
-> Parser StorageGetCookies
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageGetCookies" ((Object -> Parser StorageGetCookies)
 -> Value -> Parser StorageGetCookies)
-> (Object -> Parser StorageGetCookies)
-> Value
-> Parser StorageGetCookies
forall a b. (a -> b) -> a -> b
$ \Object
o -> [NetworkCookie] -> StorageGetCookies
StorageGetCookies
    ([NetworkCookie] -> StorageGetCookies)
-> Parser [NetworkCookie] -> Parser StorageGetCookies
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [NetworkCookie]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"cookies"
instance Command PStorageGetCookies where
  type CommandResponse PStorageGetCookies = StorageGetCookies
  commandName :: Proxy PStorageGetCookies -> String
commandName Proxy PStorageGetCookies
_ = String
"Storage.getCookies"

-- | Sets given cookies.

-- | Parameters of the 'Storage.setCookies' command.
data PStorageSetCookies = PStorageSetCookies
  {
    -- | Cookies to be set.
    PStorageSetCookies -> [NetworkCookieParam]
pStorageSetCookiesCookies :: [DOMPageNetworkEmulationSecurity.NetworkCookieParam],
    -- | Browser context to use when called on the browser endpoint.
    PStorageSetCookies -> Maybe Text
pStorageSetCookiesBrowserContextId :: Maybe BrowserTarget.BrowserBrowserContextID
  }
  deriving (PStorageSetCookies -> PStorageSetCookies -> Bool
(PStorageSetCookies -> PStorageSetCookies -> Bool)
-> (PStorageSetCookies -> PStorageSetCookies -> Bool)
-> Eq PStorageSetCookies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageSetCookies -> PStorageSetCookies -> Bool
$c/= :: PStorageSetCookies -> PStorageSetCookies -> Bool
== :: PStorageSetCookies -> PStorageSetCookies -> Bool
$c== :: PStorageSetCookies -> PStorageSetCookies -> Bool
Eq, Int -> PStorageSetCookies -> ShowS
[PStorageSetCookies] -> ShowS
PStorageSetCookies -> String
(Int -> PStorageSetCookies -> ShowS)
-> (PStorageSetCookies -> String)
-> ([PStorageSetCookies] -> ShowS)
-> Show PStorageSetCookies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageSetCookies] -> ShowS
$cshowList :: [PStorageSetCookies] -> ShowS
show :: PStorageSetCookies -> String
$cshow :: PStorageSetCookies -> String
showsPrec :: Int -> PStorageSetCookies -> ShowS
$cshowsPrec :: Int -> PStorageSetCookies -> ShowS
Show)
pStorageSetCookies
  {-
  -- | Cookies to be set.
  -}
  :: [DOMPageNetworkEmulationSecurity.NetworkCookieParam]
  -> PStorageSetCookies
pStorageSetCookies :: [NetworkCookieParam] -> PStorageSetCookies
pStorageSetCookies
  [NetworkCookieParam]
arg_pStorageSetCookiesCookies
  = [NetworkCookieParam] -> Maybe Text -> PStorageSetCookies
PStorageSetCookies
    [NetworkCookieParam]
arg_pStorageSetCookiesCookies
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PStorageSetCookies where
  toJSON :: PStorageSetCookies -> Value
toJSON PStorageSetCookies
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
"cookies" Text -> [NetworkCookieParam] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([NetworkCookieParam] -> Pair)
-> Maybe [NetworkCookieParam] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NetworkCookieParam] -> Maybe [NetworkCookieParam]
forall a. a -> Maybe a
Just (PStorageSetCookies -> [NetworkCookieParam]
pStorageSetCookiesCookies PStorageSetCookies
p),
    (Text
"browserContextId" 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
<$> (PStorageSetCookies -> Maybe Text
pStorageSetCookiesBrowserContextId PStorageSetCookies
p)
    ]
instance Command PStorageSetCookies where
  type CommandResponse PStorageSetCookies = ()
  commandName :: Proxy PStorageSetCookies -> String
commandName Proxy PStorageSetCookies
_ = String
"Storage.setCookies"
  fromJSON :: Proxy PStorageSetCookies
-> Value -> Result (CommandResponse PStorageSetCookies)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageSetCookies -> Result ())
-> Proxy PStorageSetCookies
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageSetCookies -> ())
-> Proxy PStorageSetCookies
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageSetCookies -> ()
forall a b. a -> b -> a
const ()

-- | Clears cookies.

-- | Parameters of the 'Storage.clearCookies' command.
data PStorageClearCookies = PStorageClearCookies
  {
    -- | Browser context to use when called on the browser endpoint.
    PStorageClearCookies -> Maybe Text
pStorageClearCookiesBrowserContextId :: Maybe BrowserTarget.BrowserBrowserContextID
  }
  deriving (PStorageClearCookies -> PStorageClearCookies -> Bool
(PStorageClearCookies -> PStorageClearCookies -> Bool)
-> (PStorageClearCookies -> PStorageClearCookies -> Bool)
-> Eq PStorageClearCookies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageClearCookies -> PStorageClearCookies -> Bool
$c/= :: PStorageClearCookies -> PStorageClearCookies -> Bool
== :: PStorageClearCookies -> PStorageClearCookies -> Bool
$c== :: PStorageClearCookies -> PStorageClearCookies -> Bool
Eq, Int -> PStorageClearCookies -> ShowS
[PStorageClearCookies] -> ShowS
PStorageClearCookies -> String
(Int -> PStorageClearCookies -> ShowS)
-> (PStorageClearCookies -> String)
-> ([PStorageClearCookies] -> ShowS)
-> Show PStorageClearCookies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageClearCookies] -> ShowS
$cshowList :: [PStorageClearCookies] -> ShowS
show :: PStorageClearCookies -> String
$cshow :: PStorageClearCookies -> String
showsPrec :: Int -> PStorageClearCookies -> ShowS
$cshowsPrec :: Int -> PStorageClearCookies -> ShowS
Show)
pStorageClearCookies
  :: PStorageClearCookies
pStorageClearCookies :: PStorageClearCookies
pStorageClearCookies
  = Maybe Text -> PStorageClearCookies
PStorageClearCookies
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PStorageClearCookies where
  toJSON :: PStorageClearCookies -> Value
toJSON PStorageClearCookies
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
"browserContextId" 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
<$> (PStorageClearCookies -> Maybe Text
pStorageClearCookiesBrowserContextId PStorageClearCookies
p)
    ]
instance Command PStorageClearCookies where
  type CommandResponse PStorageClearCookies = ()
  commandName :: Proxy PStorageClearCookies -> String
commandName Proxy PStorageClearCookies
_ = String
"Storage.clearCookies"
  fromJSON :: Proxy PStorageClearCookies
-> Value -> Result (CommandResponse PStorageClearCookies)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageClearCookies -> Result ())
-> Proxy PStorageClearCookies
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageClearCookies -> ())
-> Proxy PStorageClearCookies
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageClearCookies -> ()
forall a b. a -> b -> a
const ()

-- | Returns usage and quota in bytes.

-- | Parameters of the 'Storage.getUsageAndQuota' command.
data PStorageGetUsageAndQuota = PStorageGetUsageAndQuota
  {
    -- | Security origin.
    PStorageGetUsageAndQuota -> Text
pStorageGetUsageAndQuotaOrigin :: T.Text
  }
  deriving (PStorageGetUsageAndQuota -> PStorageGetUsageAndQuota -> Bool
(PStorageGetUsageAndQuota -> PStorageGetUsageAndQuota -> Bool)
-> (PStorageGetUsageAndQuota -> PStorageGetUsageAndQuota -> Bool)
-> Eq PStorageGetUsageAndQuota
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageGetUsageAndQuota -> PStorageGetUsageAndQuota -> Bool
$c/= :: PStorageGetUsageAndQuota -> PStorageGetUsageAndQuota -> Bool
== :: PStorageGetUsageAndQuota -> PStorageGetUsageAndQuota -> Bool
$c== :: PStorageGetUsageAndQuota -> PStorageGetUsageAndQuota -> Bool
Eq, Int -> PStorageGetUsageAndQuota -> ShowS
[PStorageGetUsageAndQuota] -> ShowS
PStorageGetUsageAndQuota -> String
(Int -> PStorageGetUsageAndQuota -> ShowS)
-> (PStorageGetUsageAndQuota -> String)
-> ([PStorageGetUsageAndQuota] -> ShowS)
-> Show PStorageGetUsageAndQuota
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageGetUsageAndQuota] -> ShowS
$cshowList :: [PStorageGetUsageAndQuota] -> ShowS
show :: PStorageGetUsageAndQuota -> String
$cshow :: PStorageGetUsageAndQuota -> String
showsPrec :: Int -> PStorageGetUsageAndQuota -> ShowS
$cshowsPrec :: Int -> PStorageGetUsageAndQuota -> ShowS
Show)
pStorageGetUsageAndQuota
  {-
  -- | Security origin.
  -}
  :: T.Text
  -> PStorageGetUsageAndQuota
pStorageGetUsageAndQuota :: Text -> PStorageGetUsageAndQuota
pStorageGetUsageAndQuota
  Text
arg_pStorageGetUsageAndQuotaOrigin
  = Text -> PStorageGetUsageAndQuota
PStorageGetUsageAndQuota
    Text
arg_pStorageGetUsageAndQuotaOrigin
instance ToJSON PStorageGetUsageAndQuota where
  toJSON :: PStorageGetUsageAndQuota -> Value
toJSON PStorageGetUsageAndQuota
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
"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 (PStorageGetUsageAndQuota -> Text
pStorageGetUsageAndQuotaOrigin PStorageGetUsageAndQuota
p)
    ]
data StorageGetUsageAndQuota = StorageGetUsageAndQuota
  {
    -- | Storage usage (bytes).
    StorageGetUsageAndQuota -> Double
storageGetUsageAndQuotaUsage :: Double,
    -- | Storage quota (bytes).
    StorageGetUsageAndQuota -> Double
storageGetUsageAndQuotaQuota :: Double,
    -- | Whether or not the origin has an active storage quota override
    StorageGetUsageAndQuota -> Bool
storageGetUsageAndQuotaOverrideActive :: Bool,
    -- | Storage usage per type (bytes).
    StorageGetUsageAndQuota -> [StorageUsageForType]
storageGetUsageAndQuotaUsageBreakdown :: [StorageUsageForType]
  }
  deriving (StorageGetUsageAndQuota -> StorageGetUsageAndQuota -> Bool
(StorageGetUsageAndQuota -> StorageGetUsageAndQuota -> Bool)
-> (StorageGetUsageAndQuota -> StorageGetUsageAndQuota -> Bool)
-> Eq StorageGetUsageAndQuota
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageGetUsageAndQuota -> StorageGetUsageAndQuota -> Bool
$c/= :: StorageGetUsageAndQuota -> StorageGetUsageAndQuota -> Bool
== :: StorageGetUsageAndQuota -> StorageGetUsageAndQuota -> Bool
$c== :: StorageGetUsageAndQuota -> StorageGetUsageAndQuota -> Bool
Eq, Int -> StorageGetUsageAndQuota -> ShowS
[StorageGetUsageAndQuota] -> ShowS
StorageGetUsageAndQuota -> String
(Int -> StorageGetUsageAndQuota -> ShowS)
-> (StorageGetUsageAndQuota -> String)
-> ([StorageGetUsageAndQuota] -> ShowS)
-> Show StorageGetUsageAndQuota
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageGetUsageAndQuota] -> ShowS
$cshowList :: [StorageGetUsageAndQuota] -> ShowS
show :: StorageGetUsageAndQuota -> String
$cshow :: StorageGetUsageAndQuota -> String
showsPrec :: Int -> StorageGetUsageAndQuota -> ShowS
$cshowsPrec :: Int -> StorageGetUsageAndQuota -> ShowS
Show)
instance FromJSON StorageGetUsageAndQuota where
  parseJSON :: Value -> Parser StorageGetUsageAndQuota
parseJSON = String
-> (Object -> Parser StorageGetUsageAndQuota)
-> Value
-> Parser StorageGetUsageAndQuota
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageGetUsageAndQuota" ((Object -> Parser StorageGetUsageAndQuota)
 -> Value -> Parser StorageGetUsageAndQuota)
-> (Object -> Parser StorageGetUsageAndQuota)
-> Value
-> Parser StorageGetUsageAndQuota
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double
-> Double
-> Bool
-> [StorageUsageForType]
-> StorageGetUsageAndQuota
StorageGetUsageAndQuota
    (Double
 -> Double
 -> Bool
 -> [StorageUsageForType]
 -> StorageGetUsageAndQuota)
-> Parser Double
-> Parser
     (Double
      -> Bool -> [StorageUsageForType] -> StorageGetUsageAndQuota)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"usage"
    Parser
  (Double
   -> Bool -> [StorageUsageForType] -> StorageGetUsageAndQuota)
-> Parser Double
-> Parser
     (Bool -> [StorageUsageForType] -> StorageGetUsageAndQuota)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"quota"
    Parser (Bool -> [StorageUsageForType] -> StorageGetUsageAndQuota)
-> Parser Bool
-> Parser ([StorageUsageForType] -> StorageGetUsageAndQuota)
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
"overrideActive"
    Parser ([StorageUsageForType] -> StorageGetUsageAndQuota)
-> Parser [StorageUsageForType] -> Parser StorageGetUsageAndQuota
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [StorageUsageForType]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"usageBreakdown"
instance Command PStorageGetUsageAndQuota where
  type CommandResponse PStorageGetUsageAndQuota = StorageGetUsageAndQuota
  commandName :: Proxy PStorageGetUsageAndQuota -> String
commandName Proxy PStorageGetUsageAndQuota
_ = String
"Storage.getUsageAndQuota"

-- | Override quota for the specified origin

-- | Parameters of the 'Storage.overrideQuotaForOrigin' command.
data PStorageOverrideQuotaForOrigin = PStorageOverrideQuotaForOrigin
  {
    -- | Security origin.
    PStorageOverrideQuotaForOrigin -> Text
pStorageOverrideQuotaForOriginOrigin :: T.Text,
    -- | The quota size (in bytes) to override the original quota with.
    --   If this is called multiple times, the overridden quota will be equal to
    --   the quotaSize provided in the final call. If this is called without
    --   specifying a quotaSize, the quota will be reset to the default value for
    --   the specified origin. If this is called multiple times with different
    --   origins, the override will be maintained for each origin until it is
    --   disabled (called without a quotaSize).
    PStorageOverrideQuotaForOrigin -> Maybe Double
pStorageOverrideQuotaForOriginQuotaSize :: Maybe Double
  }
  deriving (PStorageOverrideQuotaForOrigin
-> PStorageOverrideQuotaForOrigin -> Bool
(PStorageOverrideQuotaForOrigin
 -> PStorageOverrideQuotaForOrigin -> Bool)
-> (PStorageOverrideQuotaForOrigin
    -> PStorageOverrideQuotaForOrigin -> Bool)
-> Eq PStorageOverrideQuotaForOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageOverrideQuotaForOrigin
-> PStorageOverrideQuotaForOrigin -> Bool
$c/= :: PStorageOverrideQuotaForOrigin
-> PStorageOverrideQuotaForOrigin -> Bool
== :: PStorageOverrideQuotaForOrigin
-> PStorageOverrideQuotaForOrigin -> Bool
$c== :: PStorageOverrideQuotaForOrigin
-> PStorageOverrideQuotaForOrigin -> Bool
Eq, Int -> PStorageOverrideQuotaForOrigin -> ShowS
[PStorageOverrideQuotaForOrigin] -> ShowS
PStorageOverrideQuotaForOrigin -> String
(Int -> PStorageOverrideQuotaForOrigin -> ShowS)
-> (PStorageOverrideQuotaForOrigin -> String)
-> ([PStorageOverrideQuotaForOrigin] -> ShowS)
-> Show PStorageOverrideQuotaForOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageOverrideQuotaForOrigin] -> ShowS
$cshowList :: [PStorageOverrideQuotaForOrigin] -> ShowS
show :: PStorageOverrideQuotaForOrigin -> String
$cshow :: PStorageOverrideQuotaForOrigin -> String
showsPrec :: Int -> PStorageOverrideQuotaForOrigin -> ShowS
$cshowsPrec :: Int -> PStorageOverrideQuotaForOrigin -> ShowS
Show)
pStorageOverrideQuotaForOrigin
  {-
  -- | Security origin.
  -}
  :: T.Text
  -> PStorageOverrideQuotaForOrigin
pStorageOverrideQuotaForOrigin :: Text -> PStorageOverrideQuotaForOrigin
pStorageOverrideQuotaForOrigin
  Text
arg_pStorageOverrideQuotaForOriginOrigin
  = Text -> Maybe Double -> PStorageOverrideQuotaForOrigin
PStorageOverrideQuotaForOrigin
    Text
arg_pStorageOverrideQuotaForOriginOrigin
    Maybe Double
forall a. Maybe a
Nothing
instance ToJSON PStorageOverrideQuotaForOrigin where
  toJSON :: PStorageOverrideQuotaForOrigin -> Value
toJSON PStorageOverrideQuotaForOrigin
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
"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 (PStorageOverrideQuotaForOrigin -> Text
pStorageOverrideQuotaForOriginOrigin PStorageOverrideQuotaForOrigin
p),
    (Text
"quotaSize" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PStorageOverrideQuotaForOrigin -> Maybe Double
pStorageOverrideQuotaForOriginQuotaSize PStorageOverrideQuotaForOrigin
p)
    ]
instance Command PStorageOverrideQuotaForOrigin where
  type CommandResponse PStorageOverrideQuotaForOrigin = ()
  commandName :: Proxy PStorageOverrideQuotaForOrigin -> String
commandName Proxy PStorageOverrideQuotaForOrigin
_ = String
"Storage.overrideQuotaForOrigin"
  fromJSON :: Proxy PStorageOverrideQuotaForOrigin
-> Value -> Result (CommandResponse PStorageOverrideQuotaForOrigin)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageOverrideQuotaForOrigin -> Result ())
-> Proxy PStorageOverrideQuotaForOrigin
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageOverrideQuotaForOrigin -> ())
-> Proxy PStorageOverrideQuotaForOrigin
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageOverrideQuotaForOrigin -> ()
forall a b. a -> b -> a
const ()

-- | Registers origin to be notified when an update occurs to its cache storage list.

-- | Parameters of the 'Storage.trackCacheStorageForOrigin' command.
data PStorageTrackCacheStorageForOrigin = PStorageTrackCacheStorageForOrigin
  {
    -- | Security origin.
    PStorageTrackCacheStorageForOrigin -> Text
pStorageTrackCacheStorageForOriginOrigin :: T.Text
  }
  deriving (PStorageTrackCacheStorageForOrigin
-> PStorageTrackCacheStorageForOrigin -> Bool
(PStorageTrackCacheStorageForOrigin
 -> PStorageTrackCacheStorageForOrigin -> Bool)
-> (PStorageTrackCacheStorageForOrigin
    -> PStorageTrackCacheStorageForOrigin -> Bool)
-> Eq PStorageTrackCacheStorageForOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageTrackCacheStorageForOrigin
-> PStorageTrackCacheStorageForOrigin -> Bool
$c/= :: PStorageTrackCacheStorageForOrigin
-> PStorageTrackCacheStorageForOrigin -> Bool
== :: PStorageTrackCacheStorageForOrigin
-> PStorageTrackCacheStorageForOrigin -> Bool
$c== :: PStorageTrackCacheStorageForOrigin
-> PStorageTrackCacheStorageForOrigin -> Bool
Eq, Int -> PStorageTrackCacheStorageForOrigin -> ShowS
[PStorageTrackCacheStorageForOrigin] -> ShowS
PStorageTrackCacheStorageForOrigin -> String
(Int -> PStorageTrackCacheStorageForOrigin -> ShowS)
-> (PStorageTrackCacheStorageForOrigin -> String)
-> ([PStorageTrackCacheStorageForOrigin] -> ShowS)
-> Show PStorageTrackCacheStorageForOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageTrackCacheStorageForOrigin] -> ShowS
$cshowList :: [PStorageTrackCacheStorageForOrigin] -> ShowS
show :: PStorageTrackCacheStorageForOrigin -> String
$cshow :: PStorageTrackCacheStorageForOrigin -> String
showsPrec :: Int -> PStorageTrackCacheStorageForOrigin -> ShowS
$cshowsPrec :: Int -> PStorageTrackCacheStorageForOrigin -> ShowS
Show)
pStorageTrackCacheStorageForOrigin
  {-
  -- | Security origin.
  -}
  :: T.Text
  -> PStorageTrackCacheStorageForOrigin
pStorageTrackCacheStorageForOrigin :: Text -> PStorageTrackCacheStorageForOrigin
pStorageTrackCacheStorageForOrigin
  Text
arg_pStorageTrackCacheStorageForOriginOrigin
  = Text -> PStorageTrackCacheStorageForOrigin
PStorageTrackCacheStorageForOrigin
    Text
arg_pStorageTrackCacheStorageForOriginOrigin
instance ToJSON PStorageTrackCacheStorageForOrigin where
  toJSON :: PStorageTrackCacheStorageForOrigin -> Value
toJSON PStorageTrackCacheStorageForOrigin
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
"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 (PStorageTrackCacheStorageForOrigin -> Text
pStorageTrackCacheStorageForOriginOrigin PStorageTrackCacheStorageForOrigin
p)
    ]
instance Command PStorageTrackCacheStorageForOrigin where
  type CommandResponse PStorageTrackCacheStorageForOrigin = ()
  commandName :: Proxy PStorageTrackCacheStorageForOrigin -> String
commandName Proxy PStorageTrackCacheStorageForOrigin
_ = String
"Storage.trackCacheStorageForOrigin"
  fromJSON :: Proxy PStorageTrackCacheStorageForOrigin
-> Value
-> Result (CommandResponse PStorageTrackCacheStorageForOrigin)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageTrackCacheStorageForOrigin -> Result ())
-> Proxy PStorageTrackCacheStorageForOrigin
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageTrackCacheStorageForOrigin -> ())
-> Proxy PStorageTrackCacheStorageForOrigin
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageTrackCacheStorageForOrigin -> ()
forall a b. a -> b -> a
const ()

-- | Registers origin to be notified when an update occurs to its IndexedDB.

-- | Parameters of the 'Storage.trackIndexedDBForOrigin' command.
data PStorageTrackIndexedDBForOrigin = PStorageTrackIndexedDBForOrigin
  {
    -- | Security origin.
    PStorageTrackIndexedDBForOrigin -> Text
pStorageTrackIndexedDBForOriginOrigin :: T.Text
  }
  deriving (PStorageTrackIndexedDBForOrigin
-> PStorageTrackIndexedDBForOrigin -> Bool
(PStorageTrackIndexedDBForOrigin
 -> PStorageTrackIndexedDBForOrigin -> Bool)
-> (PStorageTrackIndexedDBForOrigin
    -> PStorageTrackIndexedDBForOrigin -> Bool)
-> Eq PStorageTrackIndexedDBForOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageTrackIndexedDBForOrigin
-> PStorageTrackIndexedDBForOrigin -> Bool
$c/= :: PStorageTrackIndexedDBForOrigin
-> PStorageTrackIndexedDBForOrigin -> Bool
== :: PStorageTrackIndexedDBForOrigin
-> PStorageTrackIndexedDBForOrigin -> Bool
$c== :: PStorageTrackIndexedDBForOrigin
-> PStorageTrackIndexedDBForOrigin -> Bool
Eq, Int -> PStorageTrackIndexedDBForOrigin -> ShowS
[PStorageTrackIndexedDBForOrigin] -> ShowS
PStorageTrackIndexedDBForOrigin -> String
(Int -> PStorageTrackIndexedDBForOrigin -> ShowS)
-> (PStorageTrackIndexedDBForOrigin -> String)
-> ([PStorageTrackIndexedDBForOrigin] -> ShowS)
-> Show PStorageTrackIndexedDBForOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageTrackIndexedDBForOrigin] -> ShowS
$cshowList :: [PStorageTrackIndexedDBForOrigin] -> ShowS
show :: PStorageTrackIndexedDBForOrigin -> String
$cshow :: PStorageTrackIndexedDBForOrigin -> String
showsPrec :: Int -> PStorageTrackIndexedDBForOrigin -> ShowS
$cshowsPrec :: Int -> PStorageTrackIndexedDBForOrigin -> ShowS
Show)
pStorageTrackIndexedDBForOrigin
  {-
  -- | Security origin.
  -}
  :: T.Text
  -> PStorageTrackIndexedDBForOrigin
pStorageTrackIndexedDBForOrigin :: Text -> PStorageTrackIndexedDBForOrigin
pStorageTrackIndexedDBForOrigin
  Text
arg_pStorageTrackIndexedDBForOriginOrigin
  = Text -> PStorageTrackIndexedDBForOrigin
PStorageTrackIndexedDBForOrigin
    Text
arg_pStorageTrackIndexedDBForOriginOrigin
instance ToJSON PStorageTrackIndexedDBForOrigin where
  toJSON :: PStorageTrackIndexedDBForOrigin -> Value
toJSON PStorageTrackIndexedDBForOrigin
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
"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 (PStorageTrackIndexedDBForOrigin -> Text
pStorageTrackIndexedDBForOriginOrigin PStorageTrackIndexedDBForOrigin
p)
    ]
instance Command PStorageTrackIndexedDBForOrigin where
  type CommandResponse PStorageTrackIndexedDBForOrigin = ()
  commandName :: Proxy PStorageTrackIndexedDBForOrigin -> String
commandName Proxy PStorageTrackIndexedDBForOrigin
_ = String
"Storage.trackIndexedDBForOrigin"
  fromJSON :: Proxy PStorageTrackIndexedDBForOrigin
-> Value
-> Result (CommandResponse PStorageTrackIndexedDBForOrigin)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageTrackIndexedDBForOrigin -> Result ())
-> Proxy PStorageTrackIndexedDBForOrigin
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageTrackIndexedDBForOrigin -> ())
-> Proxy PStorageTrackIndexedDBForOrigin
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageTrackIndexedDBForOrigin -> ()
forall a b. a -> b -> a
const ()

-- | Registers storage key to be notified when an update occurs to its IndexedDB.

-- | Parameters of the 'Storage.trackIndexedDBForStorageKey' command.
data PStorageTrackIndexedDBForStorageKey = PStorageTrackIndexedDBForStorageKey
  {
    -- | Storage key.
    PStorageTrackIndexedDBForStorageKey -> Text
pStorageTrackIndexedDBForStorageKeyStorageKey :: T.Text
  }
  deriving (PStorageTrackIndexedDBForStorageKey
-> PStorageTrackIndexedDBForStorageKey -> Bool
(PStorageTrackIndexedDBForStorageKey
 -> PStorageTrackIndexedDBForStorageKey -> Bool)
-> (PStorageTrackIndexedDBForStorageKey
    -> PStorageTrackIndexedDBForStorageKey -> Bool)
-> Eq PStorageTrackIndexedDBForStorageKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageTrackIndexedDBForStorageKey
-> PStorageTrackIndexedDBForStorageKey -> Bool
$c/= :: PStorageTrackIndexedDBForStorageKey
-> PStorageTrackIndexedDBForStorageKey -> Bool
== :: PStorageTrackIndexedDBForStorageKey
-> PStorageTrackIndexedDBForStorageKey -> Bool
$c== :: PStorageTrackIndexedDBForStorageKey
-> PStorageTrackIndexedDBForStorageKey -> Bool
Eq, Int -> PStorageTrackIndexedDBForStorageKey -> ShowS
[PStorageTrackIndexedDBForStorageKey] -> ShowS
PStorageTrackIndexedDBForStorageKey -> String
(Int -> PStorageTrackIndexedDBForStorageKey -> ShowS)
-> (PStorageTrackIndexedDBForStorageKey -> String)
-> ([PStorageTrackIndexedDBForStorageKey] -> ShowS)
-> Show PStorageTrackIndexedDBForStorageKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageTrackIndexedDBForStorageKey] -> ShowS
$cshowList :: [PStorageTrackIndexedDBForStorageKey] -> ShowS
show :: PStorageTrackIndexedDBForStorageKey -> String
$cshow :: PStorageTrackIndexedDBForStorageKey -> String
showsPrec :: Int -> PStorageTrackIndexedDBForStorageKey -> ShowS
$cshowsPrec :: Int -> PStorageTrackIndexedDBForStorageKey -> ShowS
Show)
pStorageTrackIndexedDBForStorageKey
  {-
  -- | Storage key.
  -}
  :: T.Text
  -> PStorageTrackIndexedDBForStorageKey
pStorageTrackIndexedDBForStorageKey :: Text -> PStorageTrackIndexedDBForStorageKey
pStorageTrackIndexedDBForStorageKey
  Text
arg_pStorageTrackIndexedDBForStorageKeyStorageKey
  = Text -> PStorageTrackIndexedDBForStorageKey
PStorageTrackIndexedDBForStorageKey
    Text
arg_pStorageTrackIndexedDBForStorageKeyStorageKey
instance ToJSON PStorageTrackIndexedDBForStorageKey where
  toJSON :: PStorageTrackIndexedDBForStorageKey -> Value
toJSON PStorageTrackIndexedDBForStorageKey
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
"storageKey" 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 (PStorageTrackIndexedDBForStorageKey -> Text
pStorageTrackIndexedDBForStorageKeyStorageKey PStorageTrackIndexedDBForStorageKey
p)
    ]
instance Command PStorageTrackIndexedDBForStorageKey where
  type CommandResponse PStorageTrackIndexedDBForStorageKey = ()
  commandName :: Proxy PStorageTrackIndexedDBForStorageKey -> String
commandName Proxy PStorageTrackIndexedDBForStorageKey
_ = String
"Storage.trackIndexedDBForStorageKey"
  fromJSON :: Proxy PStorageTrackIndexedDBForStorageKey
-> Value
-> Result (CommandResponse PStorageTrackIndexedDBForStorageKey)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageTrackIndexedDBForStorageKey -> Result ())
-> Proxy PStorageTrackIndexedDBForStorageKey
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageTrackIndexedDBForStorageKey -> ())
-> Proxy PStorageTrackIndexedDBForStorageKey
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageTrackIndexedDBForStorageKey -> ()
forall a b. a -> b -> a
const ()

-- | Unregisters origin from receiving notifications for cache storage.

-- | Parameters of the 'Storage.untrackCacheStorageForOrigin' command.
data PStorageUntrackCacheStorageForOrigin = PStorageUntrackCacheStorageForOrigin
  {
    -- | Security origin.
    PStorageUntrackCacheStorageForOrigin -> Text
pStorageUntrackCacheStorageForOriginOrigin :: T.Text
  }
  deriving (PStorageUntrackCacheStorageForOrigin
-> PStorageUntrackCacheStorageForOrigin -> Bool
(PStorageUntrackCacheStorageForOrigin
 -> PStorageUntrackCacheStorageForOrigin -> Bool)
-> (PStorageUntrackCacheStorageForOrigin
    -> PStorageUntrackCacheStorageForOrigin -> Bool)
-> Eq PStorageUntrackCacheStorageForOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageUntrackCacheStorageForOrigin
-> PStorageUntrackCacheStorageForOrigin -> Bool
$c/= :: PStorageUntrackCacheStorageForOrigin
-> PStorageUntrackCacheStorageForOrigin -> Bool
== :: PStorageUntrackCacheStorageForOrigin
-> PStorageUntrackCacheStorageForOrigin -> Bool
$c== :: PStorageUntrackCacheStorageForOrigin
-> PStorageUntrackCacheStorageForOrigin -> Bool
Eq, Int -> PStorageUntrackCacheStorageForOrigin -> ShowS
[PStorageUntrackCacheStorageForOrigin] -> ShowS
PStorageUntrackCacheStorageForOrigin -> String
(Int -> PStorageUntrackCacheStorageForOrigin -> ShowS)
-> (PStorageUntrackCacheStorageForOrigin -> String)
-> ([PStorageUntrackCacheStorageForOrigin] -> ShowS)
-> Show PStorageUntrackCacheStorageForOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageUntrackCacheStorageForOrigin] -> ShowS
$cshowList :: [PStorageUntrackCacheStorageForOrigin] -> ShowS
show :: PStorageUntrackCacheStorageForOrigin -> String
$cshow :: PStorageUntrackCacheStorageForOrigin -> String
showsPrec :: Int -> PStorageUntrackCacheStorageForOrigin -> ShowS
$cshowsPrec :: Int -> PStorageUntrackCacheStorageForOrigin -> ShowS
Show)
pStorageUntrackCacheStorageForOrigin
  {-
  -- | Security origin.
  -}
  :: T.Text
  -> PStorageUntrackCacheStorageForOrigin
pStorageUntrackCacheStorageForOrigin :: Text -> PStorageUntrackCacheStorageForOrigin
pStorageUntrackCacheStorageForOrigin
  Text
arg_pStorageUntrackCacheStorageForOriginOrigin
  = Text -> PStorageUntrackCacheStorageForOrigin
PStorageUntrackCacheStorageForOrigin
    Text
arg_pStorageUntrackCacheStorageForOriginOrigin
instance ToJSON PStorageUntrackCacheStorageForOrigin where
  toJSON :: PStorageUntrackCacheStorageForOrigin -> Value
toJSON PStorageUntrackCacheStorageForOrigin
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
"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 (PStorageUntrackCacheStorageForOrigin -> Text
pStorageUntrackCacheStorageForOriginOrigin PStorageUntrackCacheStorageForOrigin
p)
    ]
instance Command PStorageUntrackCacheStorageForOrigin where
  type CommandResponse PStorageUntrackCacheStorageForOrigin = ()
  commandName :: Proxy PStorageUntrackCacheStorageForOrigin -> String
commandName Proxy PStorageUntrackCacheStorageForOrigin
_ = String
"Storage.untrackCacheStorageForOrigin"
  fromJSON :: Proxy PStorageUntrackCacheStorageForOrigin
-> Value
-> Result (CommandResponse PStorageUntrackCacheStorageForOrigin)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageUntrackCacheStorageForOrigin -> Result ())
-> Proxy PStorageUntrackCacheStorageForOrigin
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageUntrackCacheStorageForOrigin -> ())
-> Proxy PStorageUntrackCacheStorageForOrigin
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageUntrackCacheStorageForOrigin -> ()
forall a b. a -> b -> a
const ()

-- | Unregisters origin from receiving notifications for IndexedDB.

-- | Parameters of the 'Storage.untrackIndexedDBForOrigin' command.
data PStorageUntrackIndexedDBForOrigin = PStorageUntrackIndexedDBForOrigin
  {
    -- | Security origin.
    PStorageUntrackIndexedDBForOrigin -> Text
pStorageUntrackIndexedDBForOriginOrigin :: T.Text
  }
  deriving (PStorageUntrackIndexedDBForOrigin
-> PStorageUntrackIndexedDBForOrigin -> Bool
(PStorageUntrackIndexedDBForOrigin
 -> PStorageUntrackIndexedDBForOrigin -> Bool)
-> (PStorageUntrackIndexedDBForOrigin
    -> PStorageUntrackIndexedDBForOrigin -> Bool)
-> Eq PStorageUntrackIndexedDBForOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageUntrackIndexedDBForOrigin
-> PStorageUntrackIndexedDBForOrigin -> Bool
$c/= :: PStorageUntrackIndexedDBForOrigin
-> PStorageUntrackIndexedDBForOrigin -> Bool
== :: PStorageUntrackIndexedDBForOrigin
-> PStorageUntrackIndexedDBForOrigin -> Bool
$c== :: PStorageUntrackIndexedDBForOrigin
-> PStorageUntrackIndexedDBForOrigin -> Bool
Eq, Int -> PStorageUntrackIndexedDBForOrigin -> ShowS
[PStorageUntrackIndexedDBForOrigin] -> ShowS
PStorageUntrackIndexedDBForOrigin -> String
(Int -> PStorageUntrackIndexedDBForOrigin -> ShowS)
-> (PStorageUntrackIndexedDBForOrigin -> String)
-> ([PStorageUntrackIndexedDBForOrigin] -> ShowS)
-> Show PStorageUntrackIndexedDBForOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageUntrackIndexedDBForOrigin] -> ShowS
$cshowList :: [PStorageUntrackIndexedDBForOrigin] -> ShowS
show :: PStorageUntrackIndexedDBForOrigin -> String
$cshow :: PStorageUntrackIndexedDBForOrigin -> String
showsPrec :: Int -> PStorageUntrackIndexedDBForOrigin -> ShowS
$cshowsPrec :: Int -> PStorageUntrackIndexedDBForOrigin -> ShowS
Show)
pStorageUntrackIndexedDBForOrigin
  {-
  -- | Security origin.
  -}
  :: T.Text
  -> PStorageUntrackIndexedDBForOrigin
pStorageUntrackIndexedDBForOrigin :: Text -> PStorageUntrackIndexedDBForOrigin
pStorageUntrackIndexedDBForOrigin
  Text
arg_pStorageUntrackIndexedDBForOriginOrigin
  = Text -> PStorageUntrackIndexedDBForOrigin
PStorageUntrackIndexedDBForOrigin
    Text
arg_pStorageUntrackIndexedDBForOriginOrigin
instance ToJSON PStorageUntrackIndexedDBForOrigin where
  toJSON :: PStorageUntrackIndexedDBForOrigin -> Value
toJSON PStorageUntrackIndexedDBForOrigin
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
"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 (PStorageUntrackIndexedDBForOrigin -> Text
pStorageUntrackIndexedDBForOriginOrigin PStorageUntrackIndexedDBForOrigin
p)
    ]
instance Command PStorageUntrackIndexedDBForOrigin where
  type CommandResponse PStorageUntrackIndexedDBForOrigin = ()
  commandName :: Proxy PStorageUntrackIndexedDBForOrigin -> String
commandName Proxy PStorageUntrackIndexedDBForOrigin
_ = String
"Storage.untrackIndexedDBForOrigin"
  fromJSON :: Proxy PStorageUntrackIndexedDBForOrigin
-> Value
-> Result (CommandResponse PStorageUntrackIndexedDBForOrigin)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageUntrackIndexedDBForOrigin -> Result ())
-> Proxy PStorageUntrackIndexedDBForOrigin
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageUntrackIndexedDBForOrigin -> ())
-> Proxy PStorageUntrackIndexedDBForOrigin
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageUntrackIndexedDBForOrigin -> ()
forall a b. a -> b -> a
const ()

-- | Unregisters storage key from receiving notifications for IndexedDB.

-- | Parameters of the 'Storage.untrackIndexedDBForStorageKey' command.
data PStorageUntrackIndexedDBForStorageKey = PStorageUntrackIndexedDBForStorageKey
  {
    -- | Storage key.
    PStorageUntrackIndexedDBForStorageKey -> Text
pStorageUntrackIndexedDBForStorageKeyStorageKey :: T.Text
  }
  deriving (PStorageUntrackIndexedDBForStorageKey
-> PStorageUntrackIndexedDBForStorageKey -> Bool
(PStorageUntrackIndexedDBForStorageKey
 -> PStorageUntrackIndexedDBForStorageKey -> Bool)
-> (PStorageUntrackIndexedDBForStorageKey
    -> PStorageUntrackIndexedDBForStorageKey -> Bool)
-> Eq PStorageUntrackIndexedDBForStorageKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageUntrackIndexedDBForStorageKey
-> PStorageUntrackIndexedDBForStorageKey -> Bool
$c/= :: PStorageUntrackIndexedDBForStorageKey
-> PStorageUntrackIndexedDBForStorageKey -> Bool
== :: PStorageUntrackIndexedDBForStorageKey
-> PStorageUntrackIndexedDBForStorageKey -> Bool
$c== :: PStorageUntrackIndexedDBForStorageKey
-> PStorageUntrackIndexedDBForStorageKey -> Bool
Eq, Int -> PStorageUntrackIndexedDBForStorageKey -> ShowS
[PStorageUntrackIndexedDBForStorageKey] -> ShowS
PStorageUntrackIndexedDBForStorageKey -> String
(Int -> PStorageUntrackIndexedDBForStorageKey -> ShowS)
-> (PStorageUntrackIndexedDBForStorageKey -> String)
-> ([PStorageUntrackIndexedDBForStorageKey] -> ShowS)
-> Show PStorageUntrackIndexedDBForStorageKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageUntrackIndexedDBForStorageKey] -> ShowS
$cshowList :: [PStorageUntrackIndexedDBForStorageKey] -> ShowS
show :: PStorageUntrackIndexedDBForStorageKey -> String
$cshow :: PStorageUntrackIndexedDBForStorageKey -> String
showsPrec :: Int -> PStorageUntrackIndexedDBForStorageKey -> ShowS
$cshowsPrec :: Int -> PStorageUntrackIndexedDBForStorageKey -> ShowS
Show)
pStorageUntrackIndexedDBForStorageKey
  {-
  -- | Storage key.
  -}
  :: T.Text
  -> PStorageUntrackIndexedDBForStorageKey
pStorageUntrackIndexedDBForStorageKey :: Text -> PStorageUntrackIndexedDBForStorageKey
pStorageUntrackIndexedDBForStorageKey
  Text
arg_pStorageUntrackIndexedDBForStorageKeyStorageKey
  = Text -> PStorageUntrackIndexedDBForStorageKey
PStorageUntrackIndexedDBForStorageKey
    Text
arg_pStorageUntrackIndexedDBForStorageKeyStorageKey
instance ToJSON PStorageUntrackIndexedDBForStorageKey where
  toJSON :: PStorageUntrackIndexedDBForStorageKey -> Value
toJSON PStorageUntrackIndexedDBForStorageKey
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
"storageKey" 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 (PStorageUntrackIndexedDBForStorageKey -> Text
pStorageUntrackIndexedDBForStorageKeyStorageKey PStorageUntrackIndexedDBForStorageKey
p)
    ]
instance Command PStorageUntrackIndexedDBForStorageKey where
  type CommandResponse PStorageUntrackIndexedDBForStorageKey = ()
  commandName :: Proxy PStorageUntrackIndexedDBForStorageKey -> String
commandName Proxy PStorageUntrackIndexedDBForStorageKey
_ = String
"Storage.untrackIndexedDBForStorageKey"
  fromJSON :: Proxy PStorageUntrackIndexedDBForStorageKey
-> Value
-> Result (CommandResponse PStorageUntrackIndexedDBForStorageKey)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageUntrackIndexedDBForStorageKey -> Result ())
-> Proxy PStorageUntrackIndexedDBForStorageKey
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageUntrackIndexedDBForStorageKey -> ())
-> Proxy PStorageUntrackIndexedDBForStorageKey
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageUntrackIndexedDBForStorageKey -> ()
forall a b. a -> b -> a
const ()

-- | Returns the number of stored Trust Tokens per issuer for the
--   current browsing context.

-- | Parameters of the 'Storage.getTrustTokens' command.
data PStorageGetTrustTokens = PStorageGetTrustTokens
  deriving (PStorageGetTrustTokens -> PStorageGetTrustTokens -> Bool
(PStorageGetTrustTokens -> PStorageGetTrustTokens -> Bool)
-> (PStorageGetTrustTokens -> PStorageGetTrustTokens -> Bool)
-> Eq PStorageGetTrustTokens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageGetTrustTokens -> PStorageGetTrustTokens -> Bool
$c/= :: PStorageGetTrustTokens -> PStorageGetTrustTokens -> Bool
== :: PStorageGetTrustTokens -> PStorageGetTrustTokens -> Bool
$c== :: PStorageGetTrustTokens -> PStorageGetTrustTokens -> Bool
Eq, Int -> PStorageGetTrustTokens -> ShowS
[PStorageGetTrustTokens] -> ShowS
PStorageGetTrustTokens -> String
(Int -> PStorageGetTrustTokens -> ShowS)
-> (PStorageGetTrustTokens -> String)
-> ([PStorageGetTrustTokens] -> ShowS)
-> Show PStorageGetTrustTokens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageGetTrustTokens] -> ShowS
$cshowList :: [PStorageGetTrustTokens] -> ShowS
show :: PStorageGetTrustTokens -> String
$cshow :: PStorageGetTrustTokens -> String
showsPrec :: Int -> PStorageGetTrustTokens -> ShowS
$cshowsPrec :: Int -> PStorageGetTrustTokens -> ShowS
Show)
pStorageGetTrustTokens
  :: PStorageGetTrustTokens
pStorageGetTrustTokens :: PStorageGetTrustTokens
pStorageGetTrustTokens
  = PStorageGetTrustTokens
PStorageGetTrustTokens
instance ToJSON PStorageGetTrustTokens where
  toJSON :: PStorageGetTrustTokens -> Value
toJSON PStorageGetTrustTokens
_ = Value
A.Null
data StorageGetTrustTokens = StorageGetTrustTokens
  {
    StorageGetTrustTokens -> [StorageTrustTokens]
storageGetTrustTokensTokens :: [StorageTrustTokens]
  }
  deriving (StorageGetTrustTokens -> StorageGetTrustTokens -> Bool
(StorageGetTrustTokens -> StorageGetTrustTokens -> Bool)
-> (StorageGetTrustTokens -> StorageGetTrustTokens -> Bool)
-> Eq StorageGetTrustTokens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageGetTrustTokens -> StorageGetTrustTokens -> Bool
$c/= :: StorageGetTrustTokens -> StorageGetTrustTokens -> Bool
== :: StorageGetTrustTokens -> StorageGetTrustTokens -> Bool
$c== :: StorageGetTrustTokens -> StorageGetTrustTokens -> Bool
Eq, Int -> StorageGetTrustTokens -> ShowS
[StorageGetTrustTokens] -> ShowS
StorageGetTrustTokens -> String
(Int -> StorageGetTrustTokens -> ShowS)
-> (StorageGetTrustTokens -> String)
-> ([StorageGetTrustTokens] -> ShowS)
-> Show StorageGetTrustTokens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageGetTrustTokens] -> ShowS
$cshowList :: [StorageGetTrustTokens] -> ShowS
show :: StorageGetTrustTokens -> String
$cshow :: StorageGetTrustTokens -> String
showsPrec :: Int -> StorageGetTrustTokens -> ShowS
$cshowsPrec :: Int -> StorageGetTrustTokens -> ShowS
Show)
instance FromJSON StorageGetTrustTokens where
  parseJSON :: Value -> Parser StorageGetTrustTokens
parseJSON = String
-> (Object -> Parser StorageGetTrustTokens)
-> Value
-> Parser StorageGetTrustTokens
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageGetTrustTokens" ((Object -> Parser StorageGetTrustTokens)
 -> Value -> Parser StorageGetTrustTokens)
-> (Object -> Parser StorageGetTrustTokens)
-> Value
-> Parser StorageGetTrustTokens
forall a b. (a -> b) -> a -> b
$ \Object
o -> [StorageTrustTokens] -> StorageGetTrustTokens
StorageGetTrustTokens
    ([StorageTrustTokens] -> StorageGetTrustTokens)
-> Parser [StorageTrustTokens] -> Parser StorageGetTrustTokens
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [StorageTrustTokens]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"tokens"
instance Command PStorageGetTrustTokens where
  type CommandResponse PStorageGetTrustTokens = StorageGetTrustTokens
  commandName :: Proxy PStorageGetTrustTokens -> String
commandName Proxy PStorageGetTrustTokens
_ = String
"Storage.getTrustTokens"

-- | Removes all Trust Tokens issued by the provided issuerOrigin.
--   Leaves other stored data, including the issuer's Redemption Records, intact.

-- | Parameters of the 'Storage.clearTrustTokens' command.
data PStorageClearTrustTokens = PStorageClearTrustTokens
  {
    PStorageClearTrustTokens -> Text
pStorageClearTrustTokensIssuerOrigin :: T.Text
  }
  deriving (PStorageClearTrustTokens -> PStorageClearTrustTokens -> Bool
(PStorageClearTrustTokens -> PStorageClearTrustTokens -> Bool)
-> (PStorageClearTrustTokens -> PStorageClearTrustTokens -> Bool)
-> Eq PStorageClearTrustTokens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageClearTrustTokens -> PStorageClearTrustTokens -> Bool
$c/= :: PStorageClearTrustTokens -> PStorageClearTrustTokens -> Bool
== :: PStorageClearTrustTokens -> PStorageClearTrustTokens -> Bool
$c== :: PStorageClearTrustTokens -> PStorageClearTrustTokens -> Bool
Eq, Int -> PStorageClearTrustTokens -> ShowS
[PStorageClearTrustTokens] -> ShowS
PStorageClearTrustTokens -> String
(Int -> PStorageClearTrustTokens -> ShowS)
-> (PStorageClearTrustTokens -> String)
-> ([PStorageClearTrustTokens] -> ShowS)
-> Show PStorageClearTrustTokens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageClearTrustTokens] -> ShowS
$cshowList :: [PStorageClearTrustTokens] -> ShowS
show :: PStorageClearTrustTokens -> String
$cshow :: PStorageClearTrustTokens -> String
showsPrec :: Int -> PStorageClearTrustTokens -> ShowS
$cshowsPrec :: Int -> PStorageClearTrustTokens -> ShowS
Show)
pStorageClearTrustTokens
  :: T.Text
  -> PStorageClearTrustTokens
pStorageClearTrustTokens :: Text -> PStorageClearTrustTokens
pStorageClearTrustTokens
  Text
arg_pStorageClearTrustTokensIssuerOrigin
  = Text -> PStorageClearTrustTokens
PStorageClearTrustTokens
    Text
arg_pStorageClearTrustTokensIssuerOrigin
instance ToJSON PStorageClearTrustTokens where
  toJSON :: PStorageClearTrustTokens -> Value
toJSON PStorageClearTrustTokens
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
"issuerOrigin" 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 (PStorageClearTrustTokens -> Text
pStorageClearTrustTokensIssuerOrigin PStorageClearTrustTokens
p)
    ]
data StorageClearTrustTokens = StorageClearTrustTokens
  {
    -- | True if any tokens were deleted, false otherwise.
    StorageClearTrustTokens -> Bool
storageClearTrustTokensDidDeleteTokens :: Bool
  }
  deriving (StorageClearTrustTokens -> StorageClearTrustTokens -> Bool
(StorageClearTrustTokens -> StorageClearTrustTokens -> Bool)
-> (StorageClearTrustTokens -> StorageClearTrustTokens -> Bool)
-> Eq StorageClearTrustTokens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageClearTrustTokens -> StorageClearTrustTokens -> Bool
$c/= :: StorageClearTrustTokens -> StorageClearTrustTokens -> Bool
== :: StorageClearTrustTokens -> StorageClearTrustTokens -> Bool
$c== :: StorageClearTrustTokens -> StorageClearTrustTokens -> Bool
Eq, Int -> StorageClearTrustTokens -> ShowS
[StorageClearTrustTokens] -> ShowS
StorageClearTrustTokens -> String
(Int -> StorageClearTrustTokens -> ShowS)
-> (StorageClearTrustTokens -> String)
-> ([StorageClearTrustTokens] -> ShowS)
-> Show StorageClearTrustTokens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageClearTrustTokens] -> ShowS
$cshowList :: [StorageClearTrustTokens] -> ShowS
show :: StorageClearTrustTokens -> String
$cshow :: StorageClearTrustTokens -> String
showsPrec :: Int -> StorageClearTrustTokens -> ShowS
$cshowsPrec :: Int -> StorageClearTrustTokens -> ShowS
Show)
instance FromJSON StorageClearTrustTokens where
  parseJSON :: Value -> Parser StorageClearTrustTokens
parseJSON = String
-> (Object -> Parser StorageClearTrustTokens)
-> Value
-> Parser StorageClearTrustTokens
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageClearTrustTokens" ((Object -> Parser StorageClearTrustTokens)
 -> Value -> Parser StorageClearTrustTokens)
-> (Object -> Parser StorageClearTrustTokens)
-> Value
-> Parser StorageClearTrustTokens
forall a b. (a -> b) -> a -> b
$ \Object
o -> Bool -> StorageClearTrustTokens
StorageClearTrustTokens
    (Bool -> StorageClearTrustTokens)
-> Parser Bool -> Parser StorageClearTrustTokens
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"didDeleteTokens"
instance Command PStorageClearTrustTokens where
  type CommandResponse PStorageClearTrustTokens = StorageClearTrustTokens
  commandName :: Proxy PStorageClearTrustTokens -> String
commandName Proxy PStorageClearTrustTokens
_ = String
"Storage.clearTrustTokens"

-- | Gets details for a named interest group.

-- | Parameters of the 'Storage.getInterestGroupDetails' command.
data PStorageGetInterestGroupDetails = PStorageGetInterestGroupDetails
  {
    PStorageGetInterestGroupDetails -> Text
pStorageGetInterestGroupDetailsOwnerOrigin :: T.Text,
    PStorageGetInterestGroupDetails -> Text
pStorageGetInterestGroupDetailsName :: T.Text
  }
  deriving (PStorageGetInterestGroupDetails
-> PStorageGetInterestGroupDetails -> Bool
(PStorageGetInterestGroupDetails
 -> PStorageGetInterestGroupDetails -> Bool)
-> (PStorageGetInterestGroupDetails
    -> PStorageGetInterestGroupDetails -> Bool)
-> Eq PStorageGetInterestGroupDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageGetInterestGroupDetails
-> PStorageGetInterestGroupDetails -> Bool
$c/= :: PStorageGetInterestGroupDetails
-> PStorageGetInterestGroupDetails -> Bool
== :: PStorageGetInterestGroupDetails
-> PStorageGetInterestGroupDetails -> Bool
$c== :: PStorageGetInterestGroupDetails
-> PStorageGetInterestGroupDetails -> Bool
Eq, Int -> PStorageGetInterestGroupDetails -> ShowS
[PStorageGetInterestGroupDetails] -> ShowS
PStorageGetInterestGroupDetails -> String
(Int -> PStorageGetInterestGroupDetails -> ShowS)
-> (PStorageGetInterestGroupDetails -> String)
-> ([PStorageGetInterestGroupDetails] -> ShowS)
-> Show PStorageGetInterestGroupDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageGetInterestGroupDetails] -> ShowS
$cshowList :: [PStorageGetInterestGroupDetails] -> ShowS
show :: PStorageGetInterestGroupDetails -> String
$cshow :: PStorageGetInterestGroupDetails -> String
showsPrec :: Int -> PStorageGetInterestGroupDetails -> ShowS
$cshowsPrec :: Int -> PStorageGetInterestGroupDetails -> ShowS
Show)
pStorageGetInterestGroupDetails
  :: T.Text
  -> T.Text
  -> PStorageGetInterestGroupDetails
pStorageGetInterestGroupDetails :: Text -> Text -> PStorageGetInterestGroupDetails
pStorageGetInterestGroupDetails
  Text
arg_pStorageGetInterestGroupDetailsOwnerOrigin
  Text
arg_pStorageGetInterestGroupDetailsName
  = Text -> Text -> PStorageGetInterestGroupDetails
PStorageGetInterestGroupDetails
    Text
arg_pStorageGetInterestGroupDetailsOwnerOrigin
    Text
arg_pStorageGetInterestGroupDetailsName
instance ToJSON PStorageGetInterestGroupDetails where
  toJSON :: PStorageGetInterestGroupDetails -> Value
toJSON PStorageGetInterestGroupDetails
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
"ownerOrigin" 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 (PStorageGetInterestGroupDetails -> Text
pStorageGetInterestGroupDetailsOwnerOrigin PStorageGetInterestGroupDetails
p),
    (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 (PStorageGetInterestGroupDetails -> Text
pStorageGetInterestGroupDetailsName PStorageGetInterestGroupDetails
p)
    ]
data StorageGetInterestGroupDetails = StorageGetInterestGroupDetails
  {
    StorageGetInterestGroupDetails -> StorageInterestGroupDetails
storageGetInterestGroupDetailsDetails :: StorageInterestGroupDetails
  }
  deriving (StorageGetInterestGroupDetails
-> StorageGetInterestGroupDetails -> Bool
(StorageGetInterestGroupDetails
 -> StorageGetInterestGroupDetails -> Bool)
-> (StorageGetInterestGroupDetails
    -> StorageGetInterestGroupDetails -> Bool)
-> Eq StorageGetInterestGroupDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageGetInterestGroupDetails
-> StorageGetInterestGroupDetails -> Bool
$c/= :: StorageGetInterestGroupDetails
-> StorageGetInterestGroupDetails -> Bool
== :: StorageGetInterestGroupDetails
-> StorageGetInterestGroupDetails -> Bool
$c== :: StorageGetInterestGroupDetails
-> StorageGetInterestGroupDetails -> Bool
Eq, Int -> StorageGetInterestGroupDetails -> ShowS
[StorageGetInterestGroupDetails] -> ShowS
StorageGetInterestGroupDetails -> String
(Int -> StorageGetInterestGroupDetails -> ShowS)
-> (StorageGetInterestGroupDetails -> String)
-> ([StorageGetInterestGroupDetails] -> ShowS)
-> Show StorageGetInterestGroupDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageGetInterestGroupDetails] -> ShowS
$cshowList :: [StorageGetInterestGroupDetails] -> ShowS
show :: StorageGetInterestGroupDetails -> String
$cshow :: StorageGetInterestGroupDetails -> String
showsPrec :: Int -> StorageGetInterestGroupDetails -> ShowS
$cshowsPrec :: Int -> StorageGetInterestGroupDetails -> ShowS
Show)
instance FromJSON StorageGetInterestGroupDetails where
  parseJSON :: Value -> Parser StorageGetInterestGroupDetails
parseJSON = String
-> (Object -> Parser StorageGetInterestGroupDetails)
-> Value
-> Parser StorageGetInterestGroupDetails
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StorageGetInterestGroupDetails" ((Object -> Parser StorageGetInterestGroupDetails)
 -> Value -> Parser StorageGetInterestGroupDetails)
-> (Object -> Parser StorageGetInterestGroupDetails)
-> Value
-> Parser StorageGetInterestGroupDetails
forall a b. (a -> b) -> a -> b
$ \Object
o -> StorageInterestGroupDetails -> StorageGetInterestGroupDetails
StorageGetInterestGroupDetails
    (StorageInterestGroupDetails -> StorageGetInterestGroupDetails)
-> Parser StorageInterestGroupDetails
-> Parser StorageGetInterestGroupDetails
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser StorageInterestGroupDetails
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"details"
instance Command PStorageGetInterestGroupDetails where
  type CommandResponse PStorageGetInterestGroupDetails = StorageGetInterestGroupDetails
  commandName :: Proxy PStorageGetInterestGroupDetails -> String
commandName Proxy PStorageGetInterestGroupDetails
_ = String
"Storage.getInterestGroupDetails"

-- | Enables/Disables issuing of interestGroupAccessed events.

-- | Parameters of the 'Storage.setInterestGroupTracking' command.
data PStorageSetInterestGroupTracking = PStorageSetInterestGroupTracking
  {
    PStorageSetInterestGroupTracking -> Bool
pStorageSetInterestGroupTrackingEnable :: Bool
  }
  deriving (PStorageSetInterestGroupTracking
-> PStorageSetInterestGroupTracking -> Bool
(PStorageSetInterestGroupTracking
 -> PStorageSetInterestGroupTracking -> Bool)
-> (PStorageSetInterestGroupTracking
    -> PStorageSetInterestGroupTracking -> Bool)
-> Eq PStorageSetInterestGroupTracking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PStorageSetInterestGroupTracking
-> PStorageSetInterestGroupTracking -> Bool
$c/= :: PStorageSetInterestGroupTracking
-> PStorageSetInterestGroupTracking -> Bool
== :: PStorageSetInterestGroupTracking
-> PStorageSetInterestGroupTracking -> Bool
$c== :: PStorageSetInterestGroupTracking
-> PStorageSetInterestGroupTracking -> Bool
Eq, Int -> PStorageSetInterestGroupTracking -> ShowS
[PStorageSetInterestGroupTracking] -> ShowS
PStorageSetInterestGroupTracking -> String
(Int -> PStorageSetInterestGroupTracking -> ShowS)
-> (PStorageSetInterestGroupTracking -> String)
-> ([PStorageSetInterestGroupTracking] -> ShowS)
-> Show PStorageSetInterestGroupTracking
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PStorageSetInterestGroupTracking] -> ShowS
$cshowList :: [PStorageSetInterestGroupTracking] -> ShowS
show :: PStorageSetInterestGroupTracking -> String
$cshow :: PStorageSetInterestGroupTracking -> String
showsPrec :: Int -> PStorageSetInterestGroupTracking -> ShowS
$cshowsPrec :: Int -> PStorageSetInterestGroupTracking -> ShowS
Show)
pStorageSetInterestGroupTracking
  :: Bool
  -> PStorageSetInterestGroupTracking
pStorageSetInterestGroupTracking :: Bool -> PStorageSetInterestGroupTracking
pStorageSetInterestGroupTracking
  Bool
arg_pStorageSetInterestGroupTrackingEnable
  = Bool -> PStorageSetInterestGroupTracking
PStorageSetInterestGroupTracking
    Bool
arg_pStorageSetInterestGroupTrackingEnable
instance ToJSON PStorageSetInterestGroupTracking where
  toJSON :: PStorageSetInterestGroupTracking -> Value
toJSON PStorageSetInterestGroupTracking
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
"enable" 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
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (PStorageSetInterestGroupTracking -> Bool
pStorageSetInterestGroupTrackingEnable PStorageSetInterestGroupTracking
p)
    ]
instance Command PStorageSetInterestGroupTracking where
  type CommandResponse PStorageSetInterestGroupTracking = ()
  commandName :: Proxy PStorageSetInterestGroupTracking -> String
commandName Proxy PStorageSetInterestGroupTracking
_ = String
"Storage.setInterestGroupTracking"
  fromJSON :: Proxy PStorageSetInterestGroupTracking
-> Value
-> Result (CommandResponse PStorageSetInterestGroupTracking)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PStorageSetInterestGroupTracking -> Result ())
-> Proxy PStorageSetInterestGroupTracking
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PStorageSetInterestGroupTracking -> ())
-> Proxy PStorageSetInterestGroupTracking
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PStorageSetInterestGroupTracking -> ()
forall a b. a -> b -> a
const ()