{-# 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 #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.AppSync.Types.ApiCache
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
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

-- | The @ApiCache@ object.
--
-- /See:/ 'newApiCache' smart constructor.
data ApiCache = ApiCache'
  { -- | Caching behavior.
    --
    -- -   __FULL_REQUEST_CACHING__: All requests are fully cached.
    --
    -- -   __PER_RESOLVER_CACHING__: Individual resolvers that you specify are
    --     cached.
    ApiCache -> Maybe ApiCachingBehavior
apiCachingBehavior :: Prelude.Maybe ApiCachingBehavior,
    -- | At-rest encryption flag for cache. You cannot update this setting after
    -- creation.
    ApiCache -> Maybe Bool
atRestEncryptionEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The cache instance status.
    --
    -- -   __AVAILABLE__: The instance is available for use.
    --
    -- -   __CREATING__: The instance is currently creating.
    --
    -- -   __DELETING__: The instance is currently deleting.
    --
    -- -   __MODIFYING__: The instance is currently modifying.
    --
    -- -   __FAILED__: The instance has failed creation.
    ApiCache -> Maybe ApiCacheStatus
status :: Prelude.Maybe ApiCacheStatus,
    -- | Transit encryption flag when connecting to cache. You cannot update this
    -- setting after creation.
    ApiCache -> Maybe Bool
transitEncryptionEnabled :: Prelude.Maybe Prelude.Bool,
    -- | TTL in seconds for cache entries.
    --
    -- Valid values are 1–3,600 seconds.
    ApiCache -> Maybe Integer
ttl :: Prelude.Maybe Prelude.Integer,
    -- | The cache instance type. Valid values are
    --
    -- -   @SMALL@
    --
    -- -   @MEDIUM@
    --
    -- -   @LARGE@
    --
    -- -   @XLARGE@
    --
    -- -   @LARGE_2X@
    --
    -- -   @LARGE_4X@
    --
    -- -   @LARGE_8X@ (not available in all regions)
    --
    -- -   @LARGE_12X@
    --
    -- Historically, instance types were identified by an EC2-style value. As
    -- of July 2020, this is deprecated, and the generic identifiers above
    -- should be used.
    --
    -- The following legacy instance types are available, but their use is
    -- discouraged:
    --
    -- -   __T2_SMALL__: A t2.small instance type.
    --
    -- -   __T2_MEDIUM__: A t2.medium instance type.
    --
    -- -   __R4_LARGE__: A r4.large instance type.
    --
    -- -   __R4_XLARGE__: A r4.xlarge instance type.
    --
    -- -   __R4_2XLARGE__: A r4.2xlarge instance type.
    --
    -- -   __R4_4XLARGE__: A r4.4xlarge instance type.
    --
    -- -   __R4_8XLARGE__: A r4.8xlarge instance type.
    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)

-- |
-- Create a value of 'ApiCache' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'apiCachingBehavior', 'apiCache_apiCachingBehavior' - Caching behavior.
--
-- -   __FULL_REQUEST_CACHING__: All requests are fully cached.
--
-- -   __PER_RESOLVER_CACHING__: Individual resolvers that you specify are
--     cached.
--
-- 'atRestEncryptionEnabled', 'apiCache_atRestEncryptionEnabled' - At-rest encryption flag for cache. You cannot update this setting after
-- creation.
--
-- 'status', 'apiCache_status' - The cache instance status.
--
-- -   __AVAILABLE__: The instance is available for use.
--
-- -   __CREATING__: The instance is currently creating.
--
-- -   __DELETING__: The instance is currently deleting.
--
-- -   __MODIFYING__: The instance is currently modifying.
--
-- -   __FAILED__: The instance has failed creation.
--
-- 'transitEncryptionEnabled', 'apiCache_transitEncryptionEnabled' - Transit encryption flag when connecting to cache. You cannot update this
-- setting after creation.
--
-- 'ttl', 'apiCache_ttl' - TTL in seconds for cache entries.
--
-- Valid values are 1–3,600 seconds.
--
-- 'type'', 'apiCache_type' - The cache instance type. Valid values are
--
-- -   @SMALL@
--
-- -   @MEDIUM@
--
-- -   @LARGE@
--
-- -   @XLARGE@
--
-- -   @LARGE_2X@
--
-- -   @LARGE_4X@
--
-- -   @LARGE_8X@ (not available in all regions)
--
-- -   @LARGE_12X@
--
-- Historically, instance types were identified by an EC2-style value. As
-- of July 2020, this is deprecated, and the generic identifiers above
-- should be used.
--
-- The following legacy instance types are available, but their use is
-- discouraged:
--
-- -   __T2_SMALL__: A t2.small instance type.
--
-- -   __T2_MEDIUM__: A t2.medium instance type.
--
-- -   __R4_LARGE__: A r4.large instance type.
--
-- -   __R4_XLARGE__: A r4.xlarge instance type.
--
-- -   __R4_2XLARGE__: A r4.2xlarge instance type.
--
-- -   __R4_4XLARGE__: A r4.4xlarge instance type.
--
-- -   __R4_8XLARGE__: A r4.8xlarge instance type.
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
    }

-- | Caching behavior.
--
-- -   __FULL_REQUEST_CACHING__: All requests are fully cached.
--
-- -   __PER_RESOLVER_CACHING__: Individual resolvers that you specify are
--     cached.
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)

-- | At-rest encryption flag for cache. You cannot update this setting after
-- creation.
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)

-- | The cache instance status.
--
-- -   __AVAILABLE__: The instance is available for use.
--
-- -   __CREATING__: The instance is currently creating.
--
-- -   __DELETING__: The instance is currently deleting.
--
-- -   __MODIFYING__: The instance is currently modifying.
--
-- -   __FAILED__: The instance has failed creation.
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)

-- | Transit encryption flag when connecting to cache. You cannot update this
-- setting after creation.
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)

-- | TTL in seconds for cache entries.
--
-- Valid values are 1–3,600 seconds.
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)

-- | The cache instance type. Valid values are
--
-- -   @SMALL@
--
-- -   @MEDIUM@
--
-- -   @LARGE@
--
-- -   @XLARGE@
--
-- -   @LARGE_2X@
--
-- -   @LARGE_4X@
--
-- -   @LARGE_8X@ (not available in all regions)
--
-- -   @LARGE_12X@
--
-- Historically, instance types were identified by an EC2-style value. As
-- of July 2020, this is deprecated, and the generic identifiers above
-- should be used.
--
-- The following legacy instance types are available, but their use is
-- discouraged:
--
-- -   __T2_SMALL__: A t2.small instance type.
--
-- -   __T2_MEDIUM__: A t2.medium instance type.
--
-- -   __R4_LARGE__: A r4.large instance type.
--
-- -   __R4_XLARGE__: A r4.xlarge instance type.
--
-- -   __R4_2XLARGE__: A r4.2xlarge instance type.
--
-- -   __R4_4XLARGE__: A r4.4xlarge instance type.
--
-- -   __R4_8XLARGE__: A r4.8xlarge instance type.
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'