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


{- |
= CacheStorage

-}


module CDP.Domains.CacheStorage (module CDP.Domains.CacheStorage) 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




-- | Type 'CacheStorage.CacheId'.
--   Unique identifier of the Cache object.
type CacheStorageCacheId = T.Text

-- | Type 'CacheStorage.CachedResponseType'.
--   type of HTTP response cached
data CacheStorageCachedResponseType = CacheStorageCachedResponseTypeBasic | CacheStorageCachedResponseTypeCors | CacheStorageCachedResponseTypeDefault | CacheStorageCachedResponseTypeError | CacheStorageCachedResponseTypeOpaqueResponse | CacheStorageCachedResponseTypeOpaqueRedirect
  deriving (Eq CacheStorageCachedResponseType
Eq CacheStorageCachedResponseType
-> (CacheStorageCachedResponseType
    -> CacheStorageCachedResponseType -> Ordering)
-> (CacheStorageCachedResponseType
    -> CacheStorageCachedResponseType -> Bool)
-> (CacheStorageCachedResponseType
    -> CacheStorageCachedResponseType -> Bool)
-> (CacheStorageCachedResponseType
    -> CacheStorageCachedResponseType -> Bool)
-> (CacheStorageCachedResponseType
    -> CacheStorageCachedResponseType -> Bool)
-> (CacheStorageCachedResponseType
    -> CacheStorageCachedResponseType
    -> CacheStorageCachedResponseType)
-> (CacheStorageCachedResponseType
    -> CacheStorageCachedResponseType
    -> CacheStorageCachedResponseType)
-> Ord CacheStorageCachedResponseType
CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Ordering
CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> CacheStorageCachedResponseType
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 :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> CacheStorageCachedResponseType
$cmin :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> CacheStorageCachedResponseType
max :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> CacheStorageCachedResponseType
$cmax :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> CacheStorageCachedResponseType
>= :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
$c>= :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
> :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
$c> :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
<= :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
$c<= :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
< :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
$c< :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
compare :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Ordering
$ccompare :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Ordering
$cp1Ord :: Eq CacheStorageCachedResponseType
Ord, CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
(CacheStorageCachedResponseType
 -> CacheStorageCachedResponseType -> Bool)
-> (CacheStorageCachedResponseType
    -> CacheStorageCachedResponseType -> Bool)
-> Eq CacheStorageCachedResponseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
$c/= :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
== :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
$c== :: CacheStorageCachedResponseType
-> CacheStorageCachedResponseType -> Bool
Eq, Int -> CacheStorageCachedResponseType -> ShowS
[CacheStorageCachedResponseType] -> ShowS
CacheStorageCachedResponseType -> String
(Int -> CacheStorageCachedResponseType -> ShowS)
-> (CacheStorageCachedResponseType -> String)
-> ([CacheStorageCachedResponseType] -> ShowS)
-> Show CacheStorageCachedResponseType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheStorageCachedResponseType] -> ShowS
$cshowList :: [CacheStorageCachedResponseType] -> ShowS
show :: CacheStorageCachedResponseType -> String
$cshow :: CacheStorageCachedResponseType -> String
showsPrec :: Int -> CacheStorageCachedResponseType -> ShowS
$cshowsPrec :: Int -> CacheStorageCachedResponseType -> ShowS
Show, ReadPrec [CacheStorageCachedResponseType]
ReadPrec CacheStorageCachedResponseType
Int -> ReadS CacheStorageCachedResponseType
ReadS [CacheStorageCachedResponseType]
(Int -> ReadS CacheStorageCachedResponseType)
-> ReadS [CacheStorageCachedResponseType]
-> ReadPrec CacheStorageCachedResponseType
-> ReadPrec [CacheStorageCachedResponseType]
-> Read CacheStorageCachedResponseType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CacheStorageCachedResponseType]
$creadListPrec :: ReadPrec [CacheStorageCachedResponseType]
readPrec :: ReadPrec CacheStorageCachedResponseType
$creadPrec :: ReadPrec CacheStorageCachedResponseType
readList :: ReadS [CacheStorageCachedResponseType]
$creadList :: ReadS [CacheStorageCachedResponseType]
readsPrec :: Int -> ReadS CacheStorageCachedResponseType
$creadsPrec :: Int -> ReadS CacheStorageCachedResponseType
Read)
instance FromJSON CacheStorageCachedResponseType where
  parseJSON :: Value -> Parser CacheStorageCachedResponseType
parseJSON = String
-> (Text -> Parser CacheStorageCachedResponseType)
-> Value
-> Parser CacheStorageCachedResponseType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"CacheStorageCachedResponseType" ((Text -> Parser CacheStorageCachedResponseType)
 -> Value -> Parser CacheStorageCachedResponseType)
-> (Text -> Parser CacheStorageCachedResponseType)
-> Value
-> Parser CacheStorageCachedResponseType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"basic" -> CacheStorageCachedResponseType
-> Parser CacheStorageCachedResponseType
forall (f :: * -> *) a. Applicative f => a -> f a
pure CacheStorageCachedResponseType
CacheStorageCachedResponseTypeBasic
    Text
"cors" -> CacheStorageCachedResponseType
-> Parser CacheStorageCachedResponseType
forall (f :: * -> *) a. Applicative f => a -> f a
pure CacheStorageCachedResponseType
CacheStorageCachedResponseTypeCors
    Text
"default" -> CacheStorageCachedResponseType
-> Parser CacheStorageCachedResponseType
forall (f :: * -> *) a. Applicative f => a -> f a
pure CacheStorageCachedResponseType
CacheStorageCachedResponseTypeDefault
    Text
"error" -> CacheStorageCachedResponseType
-> Parser CacheStorageCachedResponseType
forall (f :: * -> *) a. Applicative f => a -> f a
pure CacheStorageCachedResponseType
CacheStorageCachedResponseTypeError
    Text
"opaqueResponse" -> CacheStorageCachedResponseType
-> Parser CacheStorageCachedResponseType
forall (f :: * -> *) a. Applicative f => a -> f a
pure CacheStorageCachedResponseType
CacheStorageCachedResponseTypeOpaqueResponse
    Text
"opaqueRedirect" -> CacheStorageCachedResponseType
-> Parser CacheStorageCachedResponseType
forall (f :: * -> *) a. Applicative f => a -> f a
pure CacheStorageCachedResponseType
CacheStorageCachedResponseTypeOpaqueRedirect
    Text
"_" -> String -> Parser CacheStorageCachedResponseType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse CacheStorageCachedResponseType"
instance ToJSON CacheStorageCachedResponseType where
  toJSON :: CacheStorageCachedResponseType -> Value
toJSON CacheStorageCachedResponseType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case CacheStorageCachedResponseType
v of
    CacheStorageCachedResponseType
CacheStorageCachedResponseTypeBasic -> Text
"basic"
    CacheStorageCachedResponseType
CacheStorageCachedResponseTypeCors -> Text
"cors"
    CacheStorageCachedResponseType
CacheStorageCachedResponseTypeDefault -> Text
"default"
    CacheStorageCachedResponseType
CacheStorageCachedResponseTypeError -> Text
"error"
    CacheStorageCachedResponseType
CacheStorageCachedResponseTypeOpaqueResponse -> Text
"opaqueResponse"
    CacheStorageCachedResponseType
CacheStorageCachedResponseTypeOpaqueRedirect -> Text
"opaqueRedirect"

-- | Type 'CacheStorage.DataEntry'.
--   Data entry.
data CacheStorageDataEntry = CacheStorageDataEntry
  {
    -- | Request URL.
    CacheStorageDataEntry -> Text
cacheStorageDataEntryRequestURL :: T.Text,
    -- | Request method.
    CacheStorageDataEntry -> Text
cacheStorageDataEntryRequestMethod :: T.Text,
    -- | Request headers
    CacheStorageDataEntry -> [CacheStorageHeader]
cacheStorageDataEntryRequestHeaders :: [CacheStorageHeader],
    -- | Number of seconds since epoch.
    CacheStorageDataEntry -> Double
cacheStorageDataEntryResponseTime :: Double,
    -- | HTTP response status code.
    CacheStorageDataEntry -> Int
cacheStorageDataEntryResponseStatus :: Int,
    -- | HTTP response status text.
    CacheStorageDataEntry -> Text
cacheStorageDataEntryResponseStatusText :: T.Text,
    -- | HTTP response type
    CacheStorageDataEntry -> CacheStorageCachedResponseType
cacheStorageDataEntryResponseType :: CacheStorageCachedResponseType,
    -- | Response headers
    CacheStorageDataEntry -> [CacheStorageHeader]
cacheStorageDataEntryResponseHeaders :: [CacheStorageHeader]
  }
  deriving (CacheStorageDataEntry -> CacheStorageDataEntry -> Bool
(CacheStorageDataEntry -> CacheStorageDataEntry -> Bool)
-> (CacheStorageDataEntry -> CacheStorageDataEntry -> Bool)
-> Eq CacheStorageDataEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheStorageDataEntry -> CacheStorageDataEntry -> Bool
$c/= :: CacheStorageDataEntry -> CacheStorageDataEntry -> Bool
== :: CacheStorageDataEntry -> CacheStorageDataEntry -> Bool
$c== :: CacheStorageDataEntry -> CacheStorageDataEntry -> Bool
Eq, Int -> CacheStorageDataEntry -> ShowS
[CacheStorageDataEntry] -> ShowS
CacheStorageDataEntry -> String
(Int -> CacheStorageDataEntry -> ShowS)
-> (CacheStorageDataEntry -> String)
-> ([CacheStorageDataEntry] -> ShowS)
-> Show CacheStorageDataEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheStorageDataEntry] -> ShowS
$cshowList :: [CacheStorageDataEntry] -> ShowS
show :: CacheStorageDataEntry -> String
$cshow :: CacheStorageDataEntry -> String
showsPrec :: Int -> CacheStorageDataEntry -> ShowS
$cshowsPrec :: Int -> CacheStorageDataEntry -> ShowS
Show)
instance FromJSON CacheStorageDataEntry where
  parseJSON :: Value -> Parser CacheStorageDataEntry
parseJSON = String
-> (Object -> Parser CacheStorageDataEntry)
-> Value
-> Parser CacheStorageDataEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CacheStorageDataEntry" ((Object -> Parser CacheStorageDataEntry)
 -> Value -> Parser CacheStorageDataEntry)
-> (Object -> Parser CacheStorageDataEntry)
-> Value
-> Parser CacheStorageDataEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> [CacheStorageHeader]
-> Double
-> Int
-> Text
-> CacheStorageCachedResponseType
-> [CacheStorageHeader]
-> CacheStorageDataEntry
CacheStorageDataEntry
    (Text
 -> Text
 -> [CacheStorageHeader]
 -> Double
 -> Int
 -> Text
 -> CacheStorageCachedResponseType
 -> [CacheStorageHeader]
 -> CacheStorageDataEntry)
-> Parser Text
-> Parser
     (Text
      -> [CacheStorageHeader]
      -> Double
      -> Int
      -> Text
      -> CacheStorageCachedResponseType
      -> [CacheStorageHeader]
      -> CacheStorageDataEntry)
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
"requestURL"
    Parser
  (Text
   -> [CacheStorageHeader]
   -> Double
   -> Int
   -> Text
   -> CacheStorageCachedResponseType
   -> [CacheStorageHeader]
   -> CacheStorageDataEntry)
-> Parser Text
-> Parser
     ([CacheStorageHeader]
      -> Double
      -> Int
      -> Text
      -> CacheStorageCachedResponseType
      -> [CacheStorageHeader]
      -> CacheStorageDataEntry)
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
"requestMethod"
    Parser
  ([CacheStorageHeader]
   -> Double
   -> Int
   -> Text
   -> CacheStorageCachedResponseType
   -> [CacheStorageHeader]
   -> CacheStorageDataEntry)
-> Parser [CacheStorageHeader]
-> Parser
     (Double
      -> Int
      -> Text
      -> CacheStorageCachedResponseType
      -> [CacheStorageHeader]
      -> CacheStorageDataEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [CacheStorageHeader]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"requestHeaders"
    Parser
  (Double
   -> Int
   -> Text
   -> CacheStorageCachedResponseType
   -> [CacheStorageHeader]
   -> CacheStorageDataEntry)
-> Parser Double
-> Parser
     (Int
      -> Text
      -> CacheStorageCachedResponseType
      -> [CacheStorageHeader]
      -> CacheStorageDataEntry)
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
"responseTime"
    Parser
  (Int
   -> Text
   -> CacheStorageCachedResponseType
   -> [CacheStorageHeader]
   -> CacheStorageDataEntry)
-> Parser Int
-> Parser
     (Text
      -> CacheStorageCachedResponseType
      -> [CacheStorageHeader]
      -> CacheStorageDataEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"responseStatus"
    Parser
  (Text
   -> CacheStorageCachedResponseType
   -> [CacheStorageHeader]
   -> CacheStorageDataEntry)
-> Parser Text
-> Parser
     (CacheStorageCachedResponseType
      -> [CacheStorageHeader] -> CacheStorageDataEntry)
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
"responseStatusText"
    Parser
  (CacheStorageCachedResponseType
   -> [CacheStorageHeader] -> CacheStorageDataEntry)
-> Parser CacheStorageCachedResponseType
-> Parser ([CacheStorageHeader] -> CacheStorageDataEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CacheStorageCachedResponseType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"responseType"
    Parser ([CacheStorageHeader] -> CacheStorageDataEntry)
-> Parser [CacheStorageHeader] -> Parser CacheStorageDataEntry
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [CacheStorageHeader]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"responseHeaders"
instance ToJSON CacheStorageDataEntry where
  toJSON :: CacheStorageDataEntry -> Value
toJSON CacheStorageDataEntry
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
"requestURL" 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 (CacheStorageDataEntry -> Text
cacheStorageDataEntryRequestURL CacheStorageDataEntry
p),
    (Text
"requestMethod" 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 (CacheStorageDataEntry -> Text
cacheStorageDataEntryRequestMethod CacheStorageDataEntry
p),
    (Text
"requestHeaders" Text -> [CacheStorageHeader] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CacheStorageHeader] -> Pair)
-> Maybe [CacheStorageHeader] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CacheStorageHeader] -> Maybe [CacheStorageHeader]
forall a. a -> Maybe a
Just (CacheStorageDataEntry -> [CacheStorageHeader]
cacheStorageDataEntryRequestHeaders CacheStorageDataEntry
p),
    (Text
"responseTime" 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 (CacheStorageDataEntry -> Double
cacheStorageDataEntryResponseTime CacheStorageDataEntry
p),
    (Text
"responseStatus" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (CacheStorageDataEntry -> Int
cacheStorageDataEntryResponseStatus CacheStorageDataEntry
p),
    (Text
"responseStatusText" 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 (CacheStorageDataEntry -> Text
cacheStorageDataEntryResponseStatusText CacheStorageDataEntry
p),
    (Text
"responseType" Text -> CacheStorageCachedResponseType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CacheStorageCachedResponseType -> Pair)
-> Maybe CacheStorageCachedResponseType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CacheStorageCachedResponseType
-> Maybe CacheStorageCachedResponseType
forall a. a -> Maybe a
Just (CacheStorageDataEntry -> CacheStorageCachedResponseType
cacheStorageDataEntryResponseType CacheStorageDataEntry
p),
    (Text
"responseHeaders" Text -> [CacheStorageHeader] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CacheStorageHeader] -> Pair)
-> Maybe [CacheStorageHeader] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CacheStorageHeader] -> Maybe [CacheStorageHeader]
forall a. a -> Maybe a
Just (CacheStorageDataEntry -> [CacheStorageHeader]
cacheStorageDataEntryResponseHeaders CacheStorageDataEntry
p)
    ]

-- | Type 'CacheStorage.Cache'.
--   Cache identifier.
data CacheStorageCache = CacheStorageCache
  {
    -- | An opaque unique id of the cache.
    CacheStorageCache -> Text
cacheStorageCacheCacheId :: CacheStorageCacheId,
    -- | Security origin of the cache.
    CacheStorageCache -> Text
cacheStorageCacheSecurityOrigin :: T.Text,
    -- | The name of the cache.
    CacheStorageCache -> Text
cacheStorageCacheCacheName :: T.Text
  }
  deriving (CacheStorageCache -> CacheStorageCache -> Bool
(CacheStorageCache -> CacheStorageCache -> Bool)
-> (CacheStorageCache -> CacheStorageCache -> Bool)
-> Eq CacheStorageCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheStorageCache -> CacheStorageCache -> Bool
$c/= :: CacheStorageCache -> CacheStorageCache -> Bool
== :: CacheStorageCache -> CacheStorageCache -> Bool
$c== :: CacheStorageCache -> CacheStorageCache -> Bool
Eq, Int -> CacheStorageCache -> ShowS
[CacheStorageCache] -> ShowS
CacheStorageCache -> String
(Int -> CacheStorageCache -> ShowS)
-> (CacheStorageCache -> String)
-> ([CacheStorageCache] -> ShowS)
-> Show CacheStorageCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheStorageCache] -> ShowS
$cshowList :: [CacheStorageCache] -> ShowS
show :: CacheStorageCache -> String
$cshow :: CacheStorageCache -> String
showsPrec :: Int -> CacheStorageCache -> ShowS
$cshowsPrec :: Int -> CacheStorageCache -> ShowS
Show)
instance FromJSON CacheStorageCache where
  parseJSON :: Value -> Parser CacheStorageCache
parseJSON = String
-> (Object -> Parser CacheStorageCache)
-> Value
-> Parser CacheStorageCache
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CacheStorageCache" ((Object -> Parser CacheStorageCache)
 -> Value -> Parser CacheStorageCache)
-> (Object -> Parser CacheStorageCache)
-> Value
-> Parser CacheStorageCache
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Text -> CacheStorageCache
CacheStorageCache
    (Text -> Text -> Text -> CacheStorageCache)
-> Parser Text -> Parser (Text -> Text -> CacheStorageCache)
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
"cacheId"
    Parser (Text -> Text -> CacheStorageCache)
-> Parser Text -> Parser (Text -> CacheStorageCache)
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
"securityOrigin"
    Parser (Text -> CacheStorageCache)
-> Parser Text -> Parser CacheStorageCache
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 ToJSON CacheStorageCache where
  toJSON :: CacheStorageCache -> Value
toJSON CacheStorageCache
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
"cacheId" 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 (CacheStorageCache -> Text
cacheStorageCacheCacheId CacheStorageCache
p),
    (Text
"securityOrigin" 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 (CacheStorageCache -> Text
cacheStorageCacheSecurityOrigin CacheStorageCache
p),
    (Text
"cacheName" 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 (CacheStorageCache -> Text
cacheStorageCacheCacheName CacheStorageCache
p)
    ]

-- | Type 'CacheStorage.Header'.
data CacheStorageHeader = CacheStorageHeader
  {
    CacheStorageHeader -> Text
cacheStorageHeaderName :: T.Text,
    CacheStorageHeader -> Text
cacheStorageHeaderValue :: T.Text
  }
  deriving (CacheStorageHeader -> CacheStorageHeader -> Bool
(CacheStorageHeader -> CacheStorageHeader -> Bool)
-> (CacheStorageHeader -> CacheStorageHeader -> Bool)
-> Eq CacheStorageHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheStorageHeader -> CacheStorageHeader -> Bool
$c/= :: CacheStorageHeader -> CacheStorageHeader -> Bool
== :: CacheStorageHeader -> CacheStorageHeader -> Bool
$c== :: CacheStorageHeader -> CacheStorageHeader -> Bool
Eq, Int -> CacheStorageHeader -> ShowS
[CacheStorageHeader] -> ShowS
CacheStorageHeader -> String
(Int -> CacheStorageHeader -> ShowS)
-> (CacheStorageHeader -> String)
-> ([CacheStorageHeader] -> ShowS)
-> Show CacheStorageHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheStorageHeader] -> ShowS
$cshowList :: [CacheStorageHeader] -> ShowS
show :: CacheStorageHeader -> String
$cshow :: CacheStorageHeader -> String
showsPrec :: Int -> CacheStorageHeader -> ShowS
$cshowsPrec :: Int -> CacheStorageHeader -> ShowS
Show)
instance FromJSON CacheStorageHeader where
  parseJSON :: Value -> Parser CacheStorageHeader
parseJSON = String
-> (Object -> Parser CacheStorageHeader)
-> Value
-> Parser CacheStorageHeader
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CacheStorageHeader" ((Object -> Parser CacheStorageHeader)
 -> Value -> Parser CacheStorageHeader)
-> (Object -> Parser CacheStorageHeader)
-> Value
-> Parser CacheStorageHeader
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> CacheStorageHeader
CacheStorageHeader
    (Text -> Text -> CacheStorageHeader)
-> Parser Text -> Parser (Text -> CacheStorageHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser (Text -> CacheStorageHeader)
-> Parser Text -> Parser CacheStorageHeader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"value"
instance ToJSON CacheStorageHeader where
  toJSON :: CacheStorageHeader -> Value
toJSON CacheStorageHeader
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (CacheStorageHeader -> Text
cacheStorageHeaderName CacheStorageHeader
p),
    (Text
"value" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (CacheStorageHeader -> Text
cacheStorageHeaderValue CacheStorageHeader
p)
    ]

-- | Type 'CacheStorage.CachedResponse'.
--   Cached response
data CacheStorageCachedResponse = CacheStorageCachedResponse
  {
    -- | Entry content, base64-encoded. (Encoded as a base64 string when passed over JSON)
    CacheStorageCachedResponse -> Text
cacheStorageCachedResponseBody :: T.Text
  }
  deriving (CacheStorageCachedResponse -> CacheStorageCachedResponse -> Bool
(CacheStorageCachedResponse -> CacheStorageCachedResponse -> Bool)
-> (CacheStorageCachedResponse
    -> CacheStorageCachedResponse -> Bool)
-> Eq CacheStorageCachedResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheStorageCachedResponse -> CacheStorageCachedResponse -> Bool
$c/= :: CacheStorageCachedResponse -> CacheStorageCachedResponse -> Bool
== :: CacheStorageCachedResponse -> CacheStorageCachedResponse -> Bool
$c== :: CacheStorageCachedResponse -> CacheStorageCachedResponse -> Bool
Eq, Int -> CacheStorageCachedResponse -> ShowS
[CacheStorageCachedResponse] -> ShowS
CacheStorageCachedResponse -> String
(Int -> CacheStorageCachedResponse -> ShowS)
-> (CacheStorageCachedResponse -> String)
-> ([CacheStorageCachedResponse] -> ShowS)
-> Show CacheStorageCachedResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheStorageCachedResponse] -> ShowS
$cshowList :: [CacheStorageCachedResponse] -> ShowS
show :: CacheStorageCachedResponse -> String
$cshow :: CacheStorageCachedResponse -> String
showsPrec :: Int -> CacheStorageCachedResponse -> ShowS
$cshowsPrec :: Int -> CacheStorageCachedResponse -> ShowS
Show)
instance FromJSON CacheStorageCachedResponse where
  parseJSON :: Value -> Parser CacheStorageCachedResponse
parseJSON = String
-> (Object -> Parser CacheStorageCachedResponse)
-> Value
-> Parser CacheStorageCachedResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CacheStorageCachedResponse" ((Object -> Parser CacheStorageCachedResponse)
 -> Value -> Parser CacheStorageCachedResponse)
-> (Object -> Parser CacheStorageCachedResponse)
-> Value
-> Parser CacheStorageCachedResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> CacheStorageCachedResponse
CacheStorageCachedResponse
    (Text -> CacheStorageCachedResponse)
-> Parser Text -> Parser CacheStorageCachedResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"body"
instance ToJSON CacheStorageCachedResponse where
  toJSON :: CacheStorageCachedResponse -> Value
toJSON CacheStorageCachedResponse
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
"body" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (CacheStorageCachedResponse -> Text
cacheStorageCachedResponseBody CacheStorageCachedResponse
p)
    ]

-- | Deletes a cache.

-- | Parameters of the 'CacheStorage.deleteCache' command.
data PCacheStorageDeleteCache = PCacheStorageDeleteCache
  {
    -- | Id of cache for deletion.
    PCacheStorageDeleteCache -> Text
pCacheStorageDeleteCacheCacheId :: CacheStorageCacheId
  }
  deriving (PCacheStorageDeleteCache -> PCacheStorageDeleteCache -> Bool
(PCacheStorageDeleteCache -> PCacheStorageDeleteCache -> Bool)
-> (PCacheStorageDeleteCache -> PCacheStorageDeleteCache -> Bool)
-> Eq PCacheStorageDeleteCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCacheStorageDeleteCache -> PCacheStorageDeleteCache -> Bool
$c/= :: PCacheStorageDeleteCache -> PCacheStorageDeleteCache -> Bool
== :: PCacheStorageDeleteCache -> PCacheStorageDeleteCache -> Bool
$c== :: PCacheStorageDeleteCache -> PCacheStorageDeleteCache -> Bool
Eq, Int -> PCacheStorageDeleteCache -> ShowS
[PCacheStorageDeleteCache] -> ShowS
PCacheStorageDeleteCache -> String
(Int -> PCacheStorageDeleteCache -> ShowS)
-> (PCacheStorageDeleteCache -> String)
-> ([PCacheStorageDeleteCache] -> ShowS)
-> Show PCacheStorageDeleteCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCacheStorageDeleteCache] -> ShowS
$cshowList :: [PCacheStorageDeleteCache] -> ShowS
show :: PCacheStorageDeleteCache -> String
$cshow :: PCacheStorageDeleteCache -> String
showsPrec :: Int -> PCacheStorageDeleteCache -> ShowS
$cshowsPrec :: Int -> PCacheStorageDeleteCache -> ShowS
Show)
pCacheStorageDeleteCache
  {-
  -- | Id of cache for deletion.
  -}
  :: CacheStorageCacheId
  -> PCacheStorageDeleteCache
pCacheStorageDeleteCache :: Text -> PCacheStorageDeleteCache
pCacheStorageDeleteCache
  Text
arg_pCacheStorageDeleteCacheCacheId
  = Text -> PCacheStorageDeleteCache
PCacheStorageDeleteCache
    Text
arg_pCacheStorageDeleteCacheCacheId
instance ToJSON PCacheStorageDeleteCache where
  toJSON :: PCacheStorageDeleteCache -> Value
toJSON PCacheStorageDeleteCache
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
"cacheId" 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 (PCacheStorageDeleteCache -> Text
pCacheStorageDeleteCacheCacheId PCacheStorageDeleteCache
p)
    ]
instance Command PCacheStorageDeleteCache where
  type CommandResponse PCacheStorageDeleteCache = ()
  commandName :: Proxy PCacheStorageDeleteCache -> String
commandName Proxy PCacheStorageDeleteCache
_ = String
"CacheStorage.deleteCache"
  fromJSON :: Proxy PCacheStorageDeleteCache
-> Value -> Result (CommandResponse PCacheStorageDeleteCache)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCacheStorageDeleteCache -> Result ())
-> Proxy PCacheStorageDeleteCache
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCacheStorageDeleteCache -> ())
-> Proxy PCacheStorageDeleteCache
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCacheStorageDeleteCache -> ()
forall a b. a -> b -> a
const ()

-- | Deletes a cache entry.

-- | Parameters of the 'CacheStorage.deleteEntry' command.
data PCacheStorageDeleteEntry = PCacheStorageDeleteEntry
  {
    -- | Id of cache where the entry will be deleted.
    PCacheStorageDeleteEntry -> Text
pCacheStorageDeleteEntryCacheId :: CacheStorageCacheId,
    -- | URL spec of the request.
    PCacheStorageDeleteEntry -> Text
pCacheStorageDeleteEntryRequest :: T.Text
  }
  deriving (PCacheStorageDeleteEntry -> PCacheStorageDeleteEntry -> Bool
(PCacheStorageDeleteEntry -> PCacheStorageDeleteEntry -> Bool)
-> (PCacheStorageDeleteEntry -> PCacheStorageDeleteEntry -> Bool)
-> Eq PCacheStorageDeleteEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCacheStorageDeleteEntry -> PCacheStorageDeleteEntry -> Bool
$c/= :: PCacheStorageDeleteEntry -> PCacheStorageDeleteEntry -> Bool
== :: PCacheStorageDeleteEntry -> PCacheStorageDeleteEntry -> Bool
$c== :: PCacheStorageDeleteEntry -> PCacheStorageDeleteEntry -> Bool
Eq, Int -> PCacheStorageDeleteEntry -> ShowS
[PCacheStorageDeleteEntry] -> ShowS
PCacheStorageDeleteEntry -> String
(Int -> PCacheStorageDeleteEntry -> ShowS)
-> (PCacheStorageDeleteEntry -> String)
-> ([PCacheStorageDeleteEntry] -> ShowS)
-> Show PCacheStorageDeleteEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCacheStorageDeleteEntry] -> ShowS
$cshowList :: [PCacheStorageDeleteEntry] -> ShowS
show :: PCacheStorageDeleteEntry -> String
$cshow :: PCacheStorageDeleteEntry -> String
showsPrec :: Int -> PCacheStorageDeleteEntry -> ShowS
$cshowsPrec :: Int -> PCacheStorageDeleteEntry -> ShowS
Show)
pCacheStorageDeleteEntry
  {-
  -- | Id of cache where the entry will be deleted.
  -}
  :: CacheStorageCacheId
  {-
  -- | URL spec of the request.
  -}
  -> T.Text
  -> PCacheStorageDeleteEntry
pCacheStorageDeleteEntry :: Text -> Text -> PCacheStorageDeleteEntry
pCacheStorageDeleteEntry
  Text
arg_pCacheStorageDeleteEntryCacheId
  Text
arg_pCacheStorageDeleteEntryRequest
  = Text -> Text -> PCacheStorageDeleteEntry
PCacheStorageDeleteEntry
    Text
arg_pCacheStorageDeleteEntryCacheId
    Text
arg_pCacheStorageDeleteEntryRequest
instance ToJSON PCacheStorageDeleteEntry where
  toJSON :: PCacheStorageDeleteEntry -> Value
toJSON PCacheStorageDeleteEntry
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
"cacheId" 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 (PCacheStorageDeleteEntry -> Text
pCacheStorageDeleteEntryCacheId PCacheStorageDeleteEntry
p),
    (Text
"request" 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 (PCacheStorageDeleteEntry -> Text
pCacheStorageDeleteEntryRequest PCacheStorageDeleteEntry
p)
    ]
instance Command PCacheStorageDeleteEntry where
  type CommandResponse PCacheStorageDeleteEntry = ()
  commandName :: Proxy PCacheStorageDeleteEntry -> String
commandName Proxy PCacheStorageDeleteEntry
_ = String
"CacheStorage.deleteEntry"
  fromJSON :: Proxy PCacheStorageDeleteEntry
-> Value -> Result (CommandResponse PCacheStorageDeleteEntry)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCacheStorageDeleteEntry -> Result ())
-> Proxy PCacheStorageDeleteEntry
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCacheStorageDeleteEntry -> ())
-> Proxy PCacheStorageDeleteEntry
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCacheStorageDeleteEntry -> ()
forall a b. a -> b -> a
const ()

-- | Requests cache names.

-- | Parameters of the 'CacheStorage.requestCacheNames' command.
data PCacheStorageRequestCacheNames = PCacheStorageRequestCacheNames
  {
    -- | Security origin.
    PCacheStorageRequestCacheNames -> Text
pCacheStorageRequestCacheNamesSecurityOrigin :: T.Text
  }
  deriving (PCacheStorageRequestCacheNames
-> PCacheStorageRequestCacheNames -> Bool
(PCacheStorageRequestCacheNames
 -> PCacheStorageRequestCacheNames -> Bool)
-> (PCacheStorageRequestCacheNames
    -> PCacheStorageRequestCacheNames -> Bool)
-> Eq PCacheStorageRequestCacheNames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCacheStorageRequestCacheNames
-> PCacheStorageRequestCacheNames -> Bool
$c/= :: PCacheStorageRequestCacheNames
-> PCacheStorageRequestCacheNames -> Bool
== :: PCacheStorageRequestCacheNames
-> PCacheStorageRequestCacheNames -> Bool
$c== :: PCacheStorageRequestCacheNames
-> PCacheStorageRequestCacheNames -> Bool
Eq, Int -> PCacheStorageRequestCacheNames -> ShowS
[PCacheStorageRequestCacheNames] -> ShowS
PCacheStorageRequestCacheNames -> String
(Int -> PCacheStorageRequestCacheNames -> ShowS)
-> (PCacheStorageRequestCacheNames -> String)
-> ([PCacheStorageRequestCacheNames] -> ShowS)
-> Show PCacheStorageRequestCacheNames
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCacheStorageRequestCacheNames] -> ShowS
$cshowList :: [PCacheStorageRequestCacheNames] -> ShowS
show :: PCacheStorageRequestCacheNames -> String
$cshow :: PCacheStorageRequestCacheNames -> String
showsPrec :: Int -> PCacheStorageRequestCacheNames -> ShowS
$cshowsPrec :: Int -> PCacheStorageRequestCacheNames -> ShowS
Show)
pCacheStorageRequestCacheNames
  {-
  -- | Security origin.
  -}
  :: T.Text
  -> PCacheStorageRequestCacheNames
pCacheStorageRequestCacheNames :: Text -> PCacheStorageRequestCacheNames
pCacheStorageRequestCacheNames
  Text
arg_pCacheStorageRequestCacheNamesSecurityOrigin
  = Text -> PCacheStorageRequestCacheNames
PCacheStorageRequestCacheNames
    Text
arg_pCacheStorageRequestCacheNamesSecurityOrigin
instance ToJSON PCacheStorageRequestCacheNames where
  toJSON :: PCacheStorageRequestCacheNames -> Value
toJSON PCacheStorageRequestCacheNames
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
"securityOrigin" 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 (PCacheStorageRequestCacheNames -> Text
pCacheStorageRequestCacheNamesSecurityOrigin PCacheStorageRequestCacheNames
p)
    ]
data CacheStorageRequestCacheNames = CacheStorageRequestCacheNames
  {
    -- | Caches for the security origin.
    CacheStorageRequestCacheNames -> [CacheStorageCache]
cacheStorageRequestCacheNamesCaches :: [CacheStorageCache]
  }
  deriving (CacheStorageRequestCacheNames
-> CacheStorageRequestCacheNames -> Bool
(CacheStorageRequestCacheNames
 -> CacheStorageRequestCacheNames -> Bool)
-> (CacheStorageRequestCacheNames
    -> CacheStorageRequestCacheNames -> Bool)
-> Eq CacheStorageRequestCacheNames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheStorageRequestCacheNames
-> CacheStorageRequestCacheNames -> Bool
$c/= :: CacheStorageRequestCacheNames
-> CacheStorageRequestCacheNames -> Bool
== :: CacheStorageRequestCacheNames
-> CacheStorageRequestCacheNames -> Bool
$c== :: CacheStorageRequestCacheNames
-> CacheStorageRequestCacheNames -> Bool
Eq, Int -> CacheStorageRequestCacheNames -> ShowS
[CacheStorageRequestCacheNames] -> ShowS
CacheStorageRequestCacheNames -> String
(Int -> CacheStorageRequestCacheNames -> ShowS)
-> (CacheStorageRequestCacheNames -> String)
-> ([CacheStorageRequestCacheNames] -> ShowS)
-> Show CacheStorageRequestCacheNames
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheStorageRequestCacheNames] -> ShowS
$cshowList :: [CacheStorageRequestCacheNames] -> ShowS
show :: CacheStorageRequestCacheNames -> String
$cshow :: CacheStorageRequestCacheNames -> String
showsPrec :: Int -> CacheStorageRequestCacheNames -> ShowS
$cshowsPrec :: Int -> CacheStorageRequestCacheNames -> ShowS
Show)
instance FromJSON CacheStorageRequestCacheNames where
  parseJSON :: Value -> Parser CacheStorageRequestCacheNames
parseJSON = String
-> (Object -> Parser CacheStorageRequestCacheNames)
-> Value
-> Parser CacheStorageRequestCacheNames
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CacheStorageRequestCacheNames" ((Object -> Parser CacheStorageRequestCacheNames)
 -> Value -> Parser CacheStorageRequestCacheNames)
-> (Object -> Parser CacheStorageRequestCacheNames)
-> Value
-> Parser CacheStorageRequestCacheNames
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CacheStorageCache] -> CacheStorageRequestCacheNames
CacheStorageRequestCacheNames
    ([CacheStorageCache] -> CacheStorageRequestCacheNames)
-> Parser [CacheStorageCache]
-> Parser CacheStorageRequestCacheNames
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CacheStorageCache]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"caches"
instance Command PCacheStorageRequestCacheNames where
  type CommandResponse PCacheStorageRequestCacheNames = CacheStorageRequestCacheNames
  commandName :: Proxy PCacheStorageRequestCacheNames -> String
commandName Proxy PCacheStorageRequestCacheNames
_ = String
"CacheStorage.requestCacheNames"

-- | Fetches cache entry.

-- | Parameters of the 'CacheStorage.requestCachedResponse' command.
data PCacheStorageRequestCachedResponse = PCacheStorageRequestCachedResponse
  {
    -- | Id of cache that contains the entry.
    PCacheStorageRequestCachedResponse -> Text
pCacheStorageRequestCachedResponseCacheId :: CacheStorageCacheId,
    -- | URL spec of the request.
    PCacheStorageRequestCachedResponse -> Text
pCacheStorageRequestCachedResponseRequestURL :: T.Text,
    -- | headers of the request.
    PCacheStorageRequestCachedResponse -> [CacheStorageHeader]
pCacheStorageRequestCachedResponseRequestHeaders :: [CacheStorageHeader]
  }
  deriving (PCacheStorageRequestCachedResponse
-> PCacheStorageRequestCachedResponse -> Bool
(PCacheStorageRequestCachedResponse
 -> PCacheStorageRequestCachedResponse -> Bool)
-> (PCacheStorageRequestCachedResponse
    -> PCacheStorageRequestCachedResponse -> Bool)
-> Eq PCacheStorageRequestCachedResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCacheStorageRequestCachedResponse
-> PCacheStorageRequestCachedResponse -> Bool
$c/= :: PCacheStorageRequestCachedResponse
-> PCacheStorageRequestCachedResponse -> Bool
== :: PCacheStorageRequestCachedResponse
-> PCacheStorageRequestCachedResponse -> Bool
$c== :: PCacheStorageRequestCachedResponse
-> PCacheStorageRequestCachedResponse -> Bool
Eq, Int -> PCacheStorageRequestCachedResponse -> ShowS
[PCacheStorageRequestCachedResponse] -> ShowS
PCacheStorageRequestCachedResponse -> String
(Int -> PCacheStorageRequestCachedResponse -> ShowS)
-> (PCacheStorageRequestCachedResponse -> String)
-> ([PCacheStorageRequestCachedResponse] -> ShowS)
-> Show PCacheStorageRequestCachedResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCacheStorageRequestCachedResponse] -> ShowS
$cshowList :: [PCacheStorageRequestCachedResponse] -> ShowS
show :: PCacheStorageRequestCachedResponse -> String
$cshow :: PCacheStorageRequestCachedResponse -> String
showsPrec :: Int -> PCacheStorageRequestCachedResponse -> ShowS
$cshowsPrec :: Int -> PCacheStorageRequestCachedResponse -> ShowS
Show)
pCacheStorageRequestCachedResponse
  {-
  -- | Id of cache that contains the entry.
  -}
  :: CacheStorageCacheId
  {-
  -- | URL spec of the request.
  -}
  -> T.Text
  {-
  -- | headers of the request.
  -}
  -> [CacheStorageHeader]
  -> PCacheStorageRequestCachedResponse
pCacheStorageRequestCachedResponse :: Text
-> Text
-> [CacheStorageHeader]
-> PCacheStorageRequestCachedResponse
pCacheStorageRequestCachedResponse
  Text
arg_pCacheStorageRequestCachedResponseCacheId
  Text
arg_pCacheStorageRequestCachedResponseRequestURL
  [CacheStorageHeader]
arg_pCacheStorageRequestCachedResponseRequestHeaders
  = Text
-> Text
-> [CacheStorageHeader]
-> PCacheStorageRequestCachedResponse
PCacheStorageRequestCachedResponse
    Text
arg_pCacheStorageRequestCachedResponseCacheId
    Text
arg_pCacheStorageRequestCachedResponseRequestURL
    [CacheStorageHeader]
arg_pCacheStorageRequestCachedResponseRequestHeaders
instance ToJSON PCacheStorageRequestCachedResponse where
  toJSON :: PCacheStorageRequestCachedResponse -> Value
toJSON PCacheStorageRequestCachedResponse
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
"cacheId" 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 (PCacheStorageRequestCachedResponse -> Text
pCacheStorageRequestCachedResponseCacheId PCacheStorageRequestCachedResponse
p),
    (Text
"requestURL" 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 (PCacheStorageRequestCachedResponse -> Text
pCacheStorageRequestCachedResponseRequestURL PCacheStorageRequestCachedResponse
p),
    (Text
"requestHeaders" Text -> [CacheStorageHeader] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CacheStorageHeader] -> Pair)
-> Maybe [CacheStorageHeader] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CacheStorageHeader] -> Maybe [CacheStorageHeader]
forall a. a -> Maybe a
Just (PCacheStorageRequestCachedResponse -> [CacheStorageHeader]
pCacheStorageRequestCachedResponseRequestHeaders PCacheStorageRequestCachedResponse
p)
    ]
data CacheStorageRequestCachedResponse = CacheStorageRequestCachedResponse
  {
    -- | Response read from the cache.
    CacheStorageRequestCachedResponse -> CacheStorageCachedResponse
cacheStorageRequestCachedResponseResponse :: CacheStorageCachedResponse
  }
  deriving (CacheStorageRequestCachedResponse
-> CacheStorageRequestCachedResponse -> Bool
(CacheStorageRequestCachedResponse
 -> CacheStorageRequestCachedResponse -> Bool)
-> (CacheStorageRequestCachedResponse
    -> CacheStorageRequestCachedResponse -> Bool)
-> Eq CacheStorageRequestCachedResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheStorageRequestCachedResponse
-> CacheStorageRequestCachedResponse -> Bool
$c/= :: CacheStorageRequestCachedResponse
-> CacheStorageRequestCachedResponse -> Bool
== :: CacheStorageRequestCachedResponse
-> CacheStorageRequestCachedResponse -> Bool
$c== :: CacheStorageRequestCachedResponse
-> CacheStorageRequestCachedResponse -> Bool
Eq, Int -> CacheStorageRequestCachedResponse -> ShowS
[CacheStorageRequestCachedResponse] -> ShowS
CacheStorageRequestCachedResponse -> String
(Int -> CacheStorageRequestCachedResponse -> ShowS)
-> (CacheStorageRequestCachedResponse -> String)
-> ([CacheStorageRequestCachedResponse] -> ShowS)
-> Show CacheStorageRequestCachedResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheStorageRequestCachedResponse] -> ShowS
$cshowList :: [CacheStorageRequestCachedResponse] -> ShowS
show :: CacheStorageRequestCachedResponse -> String
$cshow :: CacheStorageRequestCachedResponse -> String
showsPrec :: Int -> CacheStorageRequestCachedResponse -> ShowS
$cshowsPrec :: Int -> CacheStorageRequestCachedResponse -> ShowS
Show)
instance FromJSON CacheStorageRequestCachedResponse where
  parseJSON :: Value -> Parser CacheStorageRequestCachedResponse
parseJSON = String
-> (Object -> Parser CacheStorageRequestCachedResponse)
-> Value
-> Parser CacheStorageRequestCachedResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CacheStorageRequestCachedResponse" ((Object -> Parser CacheStorageRequestCachedResponse)
 -> Value -> Parser CacheStorageRequestCachedResponse)
-> (Object -> Parser CacheStorageRequestCachedResponse)
-> Value
-> Parser CacheStorageRequestCachedResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> CacheStorageCachedResponse -> CacheStorageRequestCachedResponse
CacheStorageRequestCachedResponse
    (CacheStorageCachedResponse -> CacheStorageRequestCachedResponse)
-> Parser CacheStorageCachedResponse
-> Parser CacheStorageRequestCachedResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CacheStorageCachedResponse
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"response"
instance Command PCacheStorageRequestCachedResponse where
  type CommandResponse PCacheStorageRequestCachedResponse = CacheStorageRequestCachedResponse
  commandName :: Proxy PCacheStorageRequestCachedResponse -> String
commandName Proxy PCacheStorageRequestCachedResponse
_ = String
"CacheStorage.requestCachedResponse"

-- | Requests data from cache.

-- | Parameters of the 'CacheStorage.requestEntries' command.
data PCacheStorageRequestEntries = PCacheStorageRequestEntries
  {
    -- | ID of cache to get entries from.
    PCacheStorageRequestEntries -> Text
pCacheStorageRequestEntriesCacheId :: CacheStorageCacheId,
    -- | Number of records to skip.
    PCacheStorageRequestEntries -> Maybe Int
pCacheStorageRequestEntriesSkipCount :: Maybe Int,
    -- | Number of records to fetch.
    PCacheStorageRequestEntries -> Maybe Int
pCacheStorageRequestEntriesPageSize :: Maybe Int,
    -- | If present, only return the entries containing this substring in the path
    PCacheStorageRequestEntries -> Maybe Text
pCacheStorageRequestEntriesPathFilter :: Maybe T.Text
  }
  deriving (PCacheStorageRequestEntries -> PCacheStorageRequestEntries -> Bool
(PCacheStorageRequestEntries
 -> PCacheStorageRequestEntries -> Bool)
-> (PCacheStorageRequestEntries
    -> PCacheStorageRequestEntries -> Bool)
-> Eq PCacheStorageRequestEntries
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCacheStorageRequestEntries -> PCacheStorageRequestEntries -> Bool
$c/= :: PCacheStorageRequestEntries -> PCacheStorageRequestEntries -> Bool
== :: PCacheStorageRequestEntries -> PCacheStorageRequestEntries -> Bool
$c== :: PCacheStorageRequestEntries -> PCacheStorageRequestEntries -> Bool
Eq, Int -> PCacheStorageRequestEntries -> ShowS
[PCacheStorageRequestEntries] -> ShowS
PCacheStorageRequestEntries -> String
(Int -> PCacheStorageRequestEntries -> ShowS)
-> (PCacheStorageRequestEntries -> String)
-> ([PCacheStorageRequestEntries] -> ShowS)
-> Show PCacheStorageRequestEntries
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCacheStorageRequestEntries] -> ShowS
$cshowList :: [PCacheStorageRequestEntries] -> ShowS
show :: PCacheStorageRequestEntries -> String
$cshow :: PCacheStorageRequestEntries -> String
showsPrec :: Int -> PCacheStorageRequestEntries -> ShowS
$cshowsPrec :: Int -> PCacheStorageRequestEntries -> ShowS
Show)
pCacheStorageRequestEntries
  {-
  -- | ID of cache to get entries from.
  -}
  :: CacheStorageCacheId
  -> PCacheStorageRequestEntries
pCacheStorageRequestEntries :: Text -> PCacheStorageRequestEntries
pCacheStorageRequestEntries
  Text
arg_pCacheStorageRequestEntriesCacheId
  = Text
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> PCacheStorageRequestEntries
PCacheStorageRequestEntries
    Text
arg_pCacheStorageRequestEntriesCacheId
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PCacheStorageRequestEntries where
  toJSON :: PCacheStorageRequestEntries -> Value
toJSON PCacheStorageRequestEntries
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
"cacheId" 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 (PCacheStorageRequestEntries -> Text
pCacheStorageRequestEntriesCacheId PCacheStorageRequestEntries
p),
    (Text
"skipCount" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PCacheStorageRequestEntries -> Maybe Int
pCacheStorageRequestEntriesSkipCount PCacheStorageRequestEntries
p),
    (Text
"pageSize" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PCacheStorageRequestEntries -> Maybe Int
pCacheStorageRequestEntriesPageSize PCacheStorageRequestEntries
p),
    (Text
"pathFilter" 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
<$> (PCacheStorageRequestEntries -> Maybe Text
pCacheStorageRequestEntriesPathFilter PCacheStorageRequestEntries
p)
    ]
data CacheStorageRequestEntries = CacheStorageRequestEntries
  {
    -- | Array of object store data entries.
    CacheStorageRequestEntries -> [CacheStorageDataEntry]
cacheStorageRequestEntriesCacheDataEntries :: [CacheStorageDataEntry],
    -- | Count of returned entries from this storage. If pathFilter is empty, it
    --   is the count of all entries from this storage.
    CacheStorageRequestEntries -> Double
cacheStorageRequestEntriesReturnCount :: Double
  }
  deriving (CacheStorageRequestEntries -> CacheStorageRequestEntries -> Bool
(CacheStorageRequestEntries -> CacheStorageRequestEntries -> Bool)
-> (CacheStorageRequestEntries
    -> CacheStorageRequestEntries -> Bool)
-> Eq CacheStorageRequestEntries
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheStorageRequestEntries -> CacheStorageRequestEntries -> Bool
$c/= :: CacheStorageRequestEntries -> CacheStorageRequestEntries -> Bool
== :: CacheStorageRequestEntries -> CacheStorageRequestEntries -> Bool
$c== :: CacheStorageRequestEntries -> CacheStorageRequestEntries -> Bool
Eq, Int -> CacheStorageRequestEntries -> ShowS
[CacheStorageRequestEntries] -> ShowS
CacheStorageRequestEntries -> String
(Int -> CacheStorageRequestEntries -> ShowS)
-> (CacheStorageRequestEntries -> String)
-> ([CacheStorageRequestEntries] -> ShowS)
-> Show CacheStorageRequestEntries
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheStorageRequestEntries] -> ShowS
$cshowList :: [CacheStorageRequestEntries] -> ShowS
show :: CacheStorageRequestEntries -> String
$cshow :: CacheStorageRequestEntries -> String
showsPrec :: Int -> CacheStorageRequestEntries -> ShowS
$cshowsPrec :: Int -> CacheStorageRequestEntries -> ShowS
Show)
instance FromJSON CacheStorageRequestEntries where
  parseJSON :: Value -> Parser CacheStorageRequestEntries
parseJSON = String
-> (Object -> Parser CacheStorageRequestEntries)
-> Value
-> Parser CacheStorageRequestEntries
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CacheStorageRequestEntries" ((Object -> Parser CacheStorageRequestEntries)
 -> Value -> Parser CacheStorageRequestEntries)
-> (Object -> Parser CacheStorageRequestEntries)
-> Value
-> Parser CacheStorageRequestEntries
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CacheStorageDataEntry] -> Double -> CacheStorageRequestEntries
CacheStorageRequestEntries
    ([CacheStorageDataEntry] -> Double -> CacheStorageRequestEntries)
-> Parser [CacheStorageDataEntry]
-> Parser (Double -> CacheStorageRequestEntries)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CacheStorageDataEntry]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"cacheDataEntries"
    Parser (Double -> CacheStorageRequestEntries)
-> Parser Double -> Parser CacheStorageRequestEntries
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
"returnCount"
instance Command PCacheStorageRequestEntries where
  type CommandResponse PCacheStorageRequestEntries = CacheStorageRequestEntries
  commandName :: Proxy PCacheStorageRequestEntries -> String
commandName Proxy PCacheStorageRequestEntries
_ = String
"CacheStorage.requestEntries"