{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Amazonka.AppSync.Types.ApiCache where
import Amazonka.AppSync.Types.ApiCacheStatus
import Amazonka.AppSync.Types.ApiCacheType
import Amazonka.AppSync.Types.ApiCachingBehavior
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
data ApiCache = ApiCache'
{
ApiCache -> Maybe ApiCachingBehavior
apiCachingBehavior :: Prelude.Maybe ApiCachingBehavior,
ApiCache -> Maybe Bool
atRestEncryptionEnabled :: Prelude.Maybe Prelude.Bool,
ApiCache -> Maybe ApiCacheStatus
status :: Prelude.Maybe ApiCacheStatus,
ApiCache -> Maybe Bool
transitEncryptionEnabled :: Prelude.Maybe Prelude.Bool,
ApiCache -> Maybe Integer
ttl :: Prelude.Maybe Prelude.Integer,
ApiCache -> Maybe ApiCacheType
type' :: Prelude.Maybe ApiCacheType
}
deriving (ApiCache -> ApiCache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiCache -> ApiCache -> Bool
$c/= :: ApiCache -> ApiCache -> Bool
== :: ApiCache -> ApiCache -> Bool
$c== :: ApiCache -> ApiCache -> Bool
Prelude.Eq, ReadPrec [ApiCache]
ReadPrec ApiCache
Int -> ReadS ApiCache
ReadS [ApiCache]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApiCache]
$creadListPrec :: ReadPrec [ApiCache]
readPrec :: ReadPrec ApiCache
$creadPrec :: ReadPrec ApiCache
readList :: ReadS [ApiCache]
$creadList :: ReadS [ApiCache]
readsPrec :: Int -> ReadS ApiCache
$creadsPrec :: Int -> ReadS ApiCache
Prelude.Read, Int -> ApiCache -> ShowS
[ApiCache] -> ShowS
ApiCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiCache] -> ShowS
$cshowList :: [ApiCache] -> ShowS
show :: ApiCache -> String
$cshow :: ApiCache -> String
showsPrec :: Int -> ApiCache -> ShowS
$cshowsPrec :: Int -> ApiCache -> ShowS
Prelude.Show, forall x. Rep ApiCache x -> ApiCache
forall x. ApiCache -> Rep ApiCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiCache x -> ApiCache
$cfrom :: forall x. ApiCache -> Rep ApiCache x
Prelude.Generic)
newApiCache ::
ApiCache
newApiCache :: ApiCache
newApiCache =
ApiCache'
{ $sel:apiCachingBehavior:ApiCache' :: Maybe ApiCachingBehavior
apiCachingBehavior = forall a. Maybe a
Prelude.Nothing,
$sel:atRestEncryptionEnabled:ApiCache' :: Maybe Bool
atRestEncryptionEnabled = forall a. Maybe a
Prelude.Nothing,
$sel:status:ApiCache' :: Maybe ApiCacheStatus
status = forall a. Maybe a
Prelude.Nothing,
$sel:transitEncryptionEnabled:ApiCache' :: Maybe Bool
transitEncryptionEnabled = forall a. Maybe a
Prelude.Nothing,
$sel:ttl:ApiCache' :: Maybe Integer
ttl = forall a. Maybe a
Prelude.Nothing,
$sel:type':ApiCache' :: Maybe ApiCacheType
type' = forall a. Maybe a
Prelude.Nothing
}
apiCache_apiCachingBehavior :: Lens.Lens' ApiCache (Prelude.Maybe ApiCachingBehavior)
apiCache_apiCachingBehavior :: Lens' ApiCache (Maybe ApiCachingBehavior)
apiCache_apiCachingBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApiCache' {Maybe ApiCachingBehavior
apiCachingBehavior :: Maybe ApiCachingBehavior
$sel:apiCachingBehavior:ApiCache' :: ApiCache -> Maybe ApiCachingBehavior
apiCachingBehavior} -> Maybe ApiCachingBehavior
apiCachingBehavior) (\s :: ApiCache
s@ApiCache' {} Maybe ApiCachingBehavior
a -> ApiCache
s {$sel:apiCachingBehavior:ApiCache' :: Maybe ApiCachingBehavior
apiCachingBehavior = Maybe ApiCachingBehavior
a} :: ApiCache)
apiCache_atRestEncryptionEnabled :: Lens.Lens' ApiCache (Prelude.Maybe Prelude.Bool)
apiCache_atRestEncryptionEnabled :: Lens' ApiCache (Maybe Bool)
apiCache_atRestEncryptionEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApiCache' {Maybe Bool
atRestEncryptionEnabled :: Maybe Bool
$sel:atRestEncryptionEnabled:ApiCache' :: ApiCache -> Maybe Bool
atRestEncryptionEnabled} -> Maybe Bool
atRestEncryptionEnabled) (\s :: ApiCache
s@ApiCache' {} Maybe Bool
a -> ApiCache
s {$sel:atRestEncryptionEnabled:ApiCache' :: Maybe Bool
atRestEncryptionEnabled = Maybe Bool
a} :: ApiCache)
apiCache_status :: Lens.Lens' ApiCache (Prelude.Maybe ApiCacheStatus)
apiCache_status :: Lens' ApiCache (Maybe ApiCacheStatus)
apiCache_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApiCache' {Maybe ApiCacheStatus
status :: Maybe ApiCacheStatus
$sel:status:ApiCache' :: ApiCache -> Maybe ApiCacheStatus
status} -> Maybe ApiCacheStatus
status) (\s :: ApiCache
s@ApiCache' {} Maybe ApiCacheStatus
a -> ApiCache
s {$sel:status:ApiCache' :: Maybe ApiCacheStatus
status = Maybe ApiCacheStatus
a} :: ApiCache)
apiCache_transitEncryptionEnabled :: Lens.Lens' ApiCache (Prelude.Maybe Prelude.Bool)
apiCache_transitEncryptionEnabled :: Lens' ApiCache (Maybe Bool)
apiCache_transitEncryptionEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApiCache' {Maybe Bool
transitEncryptionEnabled :: Maybe Bool
$sel:transitEncryptionEnabled:ApiCache' :: ApiCache -> Maybe Bool
transitEncryptionEnabled} -> Maybe Bool
transitEncryptionEnabled) (\s :: ApiCache
s@ApiCache' {} Maybe Bool
a -> ApiCache
s {$sel:transitEncryptionEnabled:ApiCache' :: Maybe Bool
transitEncryptionEnabled = Maybe Bool
a} :: ApiCache)
apiCache_ttl :: Lens.Lens' ApiCache (Prelude.Maybe Prelude.Integer)
apiCache_ttl :: Lens' ApiCache (Maybe Integer)
apiCache_ttl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApiCache' {Maybe Integer
ttl :: Maybe Integer
$sel:ttl:ApiCache' :: ApiCache -> Maybe Integer
ttl} -> Maybe Integer
ttl) (\s :: ApiCache
s@ApiCache' {} Maybe Integer
a -> ApiCache
s {$sel:ttl:ApiCache' :: Maybe Integer
ttl = Maybe Integer
a} :: ApiCache)
apiCache_type :: Lens.Lens' ApiCache (Prelude.Maybe ApiCacheType)
apiCache_type :: Lens' ApiCache (Maybe ApiCacheType)
apiCache_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApiCache' {Maybe ApiCacheType
type' :: Maybe ApiCacheType
$sel:type':ApiCache' :: ApiCache -> Maybe ApiCacheType
type'} -> Maybe ApiCacheType
type') (\s :: ApiCache
s@ApiCache' {} Maybe ApiCacheType
a -> ApiCache
s {$sel:type':ApiCache' :: Maybe ApiCacheType
type' = Maybe ApiCacheType
a} :: ApiCache)
instance Data.FromJSON ApiCache where
parseJSON :: Value -> Parser ApiCache
parseJSON =
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
String
"ApiCache"
( \Object
x ->
Maybe ApiCachingBehavior
-> Maybe Bool
-> Maybe ApiCacheStatus
-> Maybe Bool
-> Maybe Integer
-> Maybe ApiCacheType
-> ApiCache
ApiCache'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"apiCachingBehavior")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"atRestEncryptionEnabled")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"status")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"transitEncryptionEnabled")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ttl")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"type")
)
instance Prelude.Hashable ApiCache where
hashWithSalt :: Int -> ApiCache -> Int
hashWithSalt Int
_salt ApiCache' {Maybe Bool
Maybe Integer
Maybe ApiCacheStatus
Maybe ApiCacheType
Maybe ApiCachingBehavior
type' :: Maybe ApiCacheType
ttl :: Maybe Integer
transitEncryptionEnabled :: Maybe Bool
status :: Maybe ApiCacheStatus
atRestEncryptionEnabled :: Maybe Bool
apiCachingBehavior :: Maybe ApiCachingBehavior
$sel:type':ApiCache' :: ApiCache -> Maybe ApiCacheType
$sel:ttl:ApiCache' :: ApiCache -> Maybe Integer
$sel:transitEncryptionEnabled:ApiCache' :: ApiCache -> Maybe Bool
$sel:status:ApiCache' :: ApiCache -> Maybe ApiCacheStatus
$sel:atRestEncryptionEnabled:ApiCache' :: ApiCache -> Maybe Bool
$sel:apiCachingBehavior:ApiCache' :: ApiCache -> Maybe ApiCachingBehavior
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApiCachingBehavior
apiCachingBehavior
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
atRestEncryptionEnabled
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApiCacheStatus
status
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
transitEncryptionEnabled
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
ttl
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApiCacheType
type'
instance Prelude.NFData ApiCache where
rnf :: ApiCache -> ()
rnf ApiCache' {Maybe Bool
Maybe Integer
Maybe ApiCacheStatus
Maybe ApiCacheType
Maybe ApiCachingBehavior
type' :: Maybe ApiCacheType
ttl :: Maybe Integer
transitEncryptionEnabled :: Maybe Bool
status :: Maybe ApiCacheStatus
atRestEncryptionEnabled :: Maybe Bool
apiCachingBehavior :: Maybe ApiCachingBehavior
$sel:type':ApiCache' :: ApiCache -> Maybe ApiCacheType
$sel:ttl:ApiCache' :: ApiCache -> Maybe Integer
$sel:transitEncryptionEnabled:ApiCache' :: ApiCache -> Maybe Bool
$sel:status:ApiCache' :: ApiCache -> Maybe ApiCacheStatus
$sel:atRestEncryptionEnabled:ApiCache' :: ApiCache -> Maybe Bool
$sel:apiCachingBehavior:ApiCache' :: ApiCache -> Maybe ApiCachingBehavior
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe ApiCachingBehavior
apiCachingBehavior
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
atRestEncryptionEnabled
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ApiCacheStatus
status
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
transitEncryptionEnabled
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
ttl
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ApiCacheType
type'