{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.CreateApiCache
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a cache for the GraphQL API.
module Amazonka.AppSync.CreateApiCache
  ( -- * Creating a Request
    CreateApiCache (..),
    newCreateApiCache,

    -- * Request Lenses
    createApiCache_atRestEncryptionEnabled,
    createApiCache_transitEncryptionEnabled,
    createApiCache_apiId,
    createApiCache_ttl,
    createApiCache_apiCachingBehavior,
    createApiCache_type,

    -- * Destructuring the Response
    CreateApiCacheResponse (..),
    newCreateApiCacheResponse,

    -- * Response Lenses
    createApiCacheResponse_apiCache,
    createApiCacheResponse_httpStatus,
  )
where

import Amazonka.AppSync.Types
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
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Represents the input of a @CreateApiCache@ operation.
--
-- /See:/ 'newCreateApiCache' smart constructor.
data CreateApiCache = CreateApiCache'
  { -- | At-rest encryption flag for cache. You cannot update this setting after
    -- creation.
    CreateApiCache -> Maybe Bool
atRestEncryptionEnabled :: Prelude.Maybe Prelude.Bool,
    -- | Transit encryption flag when connecting to cache. You cannot update this
    -- setting after creation.
    CreateApiCache -> Maybe Bool
transitEncryptionEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The GraphQL API ID.
    CreateApiCache -> Text
apiId :: Prelude.Text,
    -- | TTL in seconds for cache entries.
    --
    -- Valid values are 1–3,600 seconds.
    CreateApiCache -> Integer
ttl :: Prelude.Integer,
    -- | Caching behavior.
    --
    -- -   __FULL_REQUEST_CACHING__: All requests are fully cached.
    --
    -- -   __PER_RESOLVER_CACHING__: Individual resolvers that you specify are
    --     cached.
    CreateApiCache -> ApiCachingBehavior
apiCachingBehavior :: ApiCachingBehavior,
    -- | 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.
    CreateApiCache -> ApiCacheType
type' :: ApiCacheType
  }
  deriving (CreateApiCache -> CreateApiCache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApiCache -> CreateApiCache -> Bool
$c/= :: CreateApiCache -> CreateApiCache -> Bool
== :: CreateApiCache -> CreateApiCache -> Bool
$c== :: CreateApiCache -> CreateApiCache -> Bool
Prelude.Eq, ReadPrec [CreateApiCache]
ReadPrec CreateApiCache
Int -> ReadS CreateApiCache
ReadS [CreateApiCache]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApiCache]
$creadListPrec :: ReadPrec [CreateApiCache]
readPrec :: ReadPrec CreateApiCache
$creadPrec :: ReadPrec CreateApiCache
readList :: ReadS [CreateApiCache]
$creadList :: ReadS [CreateApiCache]
readsPrec :: Int -> ReadS CreateApiCache
$creadsPrec :: Int -> ReadS CreateApiCache
Prelude.Read, Int -> CreateApiCache -> ShowS
[CreateApiCache] -> ShowS
CreateApiCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApiCache] -> ShowS
$cshowList :: [CreateApiCache] -> ShowS
show :: CreateApiCache -> String
$cshow :: CreateApiCache -> String
showsPrec :: Int -> CreateApiCache -> ShowS
$cshowsPrec :: Int -> CreateApiCache -> ShowS
Prelude.Show, forall x. Rep CreateApiCache x -> CreateApiCache
forall x. CreateApiCache -> Rep CreateApiCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateApiCache x -> CreateApiCache
$cfrom :: forall x. CreateApiCache -> Rep CreateApiCache x
Prelude.Generic)

-- |
-- Create a value of 'CreateApiCache' 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:
--
-- 'atRestEncryptionEnabled', 'createApiCache_atRestEncryptionEnabled' - At-rest encryption flag for cache. You cannot update this setting after
-- creation.
--
-- 'transitEncryptionEnabled', 'createApiCache_transitEncryptionEnabled' - Transit encryption flag when connecting to cache. You cannot update this
-- setting after creation.
--
-- 'apiId', 'createApiCache_apiId' - The GraphQL API ID.
--
-- 'ttl', 'createApiCache_ttl' - TTL in seconds for cache entries.
--
-- Valid values are 1–3,600 seconds.
--
-- 'apiCachingBehavior', 'createApiCache_apiCachingBehavior' - Caching behavior.
--
-- -   __FULL_REQUEST_CACHING__: All requests are fully cached.
--
-- -   __PER_RESOLVER_CACHING__: Individual resolvers that you specify are
--     cached.
--
-- 'type'', 'createApiCache_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.
newCreateApiCache ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'ttl'
  Prelude.Integer ->
  -- | 'apiCachingBehavior'
  ApiCachingBehavior ->
  -- | 'type''
  ApiCacheType ->
  CreateApiCache
newCreateApiCache :: Text
-> Integer -> ApiCachingBehavior -> ApiCacheType -> CreateApiCache
newCreateApiCache
  Text
pApiId_
  Integer
pTtl_
  ApiCachingBehavior
pApiCachingBehavior_
  ApiCacheType
pType_ =
    CreateApiCache'
      { $sel:atRestEncryptionEnabled:CreateApiCache' :: Maybe Bool
atRestEncryptionEnabled =
          forall a. Maybe a
Prelude.Nothing,
        $sel:transitEncryptionEnabled:CreateApiCache' :: Maybe Bool
transitEncryptionEnabled = forall a. Maybe a
Prelude.Nothing,
        $sel:apiId:CreateApiCache' :: Text
apiId = Text
pApiId_,
        $sel:ttl:CreateApiCache' :: Integer
ttl = Integer
pTtl_,
        $sel:apiCachingBehavior:CreateApiCache' :: ApiCachingBehavior
apiCachingBehavior = ApiCachingBehavior
pApiCachingBehavior_,
        $sel:type':CreateApiCache' :: ApiCacheType
type' = ApiCacheType
pType_
      }

-- | At-rest encryption flag for cache. You cannot update this setting after
-- creation.
createApiCache_atRestEncryptionEnabled :: Lens.Lens' CreateApiCache (Prelude.Maybe Prelude.Bool)
createApiCache_atRestEncryptionEnabled :: Lens' CreateApiCache (Maybe Bool)
createApiCache_atRestEncryptionEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiCache' {Maybe Bool
atRestEncryptionEnabled :: Maybe Bool
$sel:atRestEncryptionEnabled:CreateApiCache' :: CreateApiCache -> Maybe Bool
atRestEncryptionEnabled} -> Maybe Bool
atRestEncryptionEnabled) (\s :: CreateApiCache
s@CreateApiCache' {} Maybe Bool
a -> CreateApiCache
s {$sel:atRestEncryptionEnabled:CreateApiCache' :: Maybe Bool
atRestEncryptionEnabled = Maybe Bool
a} :: CreateApiCache)

-- | Transit encryption flag when connecting to cache. You cannot update this
-- setting after creation.
createApiCache_transitEncryptionEnabled :: Lens.Lens' CreateApiCache (Prelude.Maybe Prelude.Bool)
createApiCache_transitEncryptionEnabled :: Lens' CreateApiCache (Maybe Bool)
createApiCache_transitEncryptionEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiCache' {Maybe Bool
transitEncryptionEnabled :: Maybe Bool
$sel:transitEncryptionEnabled:CreateApiCache' :: CreateApiCache -> Maybe Bool
transitEncryptionEnabled} -> Maybe Bool
transitEncryptionEnabled) (\s :: CreateApiCache
s@CreateApiCache' {} Maybe Bool
a -> CreateApiCache
s {$sel:transitEncryptionEnabled:CreateApiCache' :: Maybe Bool
transitEncryptionEnabled = Maybe Bool
a} :: CreateApiCache)

-- | The GraphQL API ID.
createApiCache_apiId :: Lens.Lens' CreateApiCache Prelude.Text
createApiCache_apiId :: Lens' CreateApiCache Text
createApiCache_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiCache' {Text
apiId :: Text
$sel:apiId:CreateApiCache' :: CreateApiCache -> Text
apiId} -> Text
apiId) (\s :: CreateApiCache
s@CreateApiCache' {} Text
a -> CreateApiCache
s {$sel:apiId:CreateApiCache' :: Text
apiId = Text
a} :: CreateApiCache)

-- | TTL in seconds for cache entries.
--
-- Valid values are 1–3,600 seconds.
createApiCache_ttl :: Lens.Lens' CreateApiCache Prelude.Integer
createApiCache_ttl :: Lens' CreateApiCache Integer
createApiCache_ttl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiCache' {Integer
ttl :: Integer
$sel:ttl:CreateApiCache' :: CreateApiCache -> Integer
ttl} -> Integer
ttl) (\s :: CreateApiCache
s@CreateApiCache' {} Integer
a -> CreateApiCache
s {$sel:ttl:CreateApiCache' :: Integer
ttl = Integer
a} :: CreateApiCache)

-- | Caching behavior.
--
-- -   __FULL_REQUEST_CACHING__: All requests are fully cached.
--
-- -   __PER_RESOLVER_CACHING__: Individual resolvers that you specify are
--     cached.
createApiCache_apiCachingBehavior :: Lens.Lens' CreateApiCache ApiCachingBehavior
createApiCache_apiCachingBehavior :: Lens' CreateApiCache ApiCachingBehavior
createApiCache_apiCachingBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiCache' {ApiCachingBehavior
apiCachingBehavior :: ApiCachingBehavior
$sel:apiCachingBehavior:CreateApiCache' :: CreateApiCache -> ApiCachingBehavior
apiCachingBehavior} -> ApiCachingBehavior
apiCachingBehavior) (\s :: CreateApiCache
s@CreateApiCache' {} ApiCachingBehavior
a -> CreateApiCache
s {$sel:apiCachingBehavior:CreateApiCache' :: ApiCachingBehavior
apiCachingBehavior = ApiCachingBehavior
a} :: CreateApiCache)

-- | 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.
createApiCache_type :: Lens.Lens' CreateApiCache ApiCacheType
createApiCache_type :: Lens' CreateApiCache ApiCacheType
createApiCache_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiCache' {ApiCacheType
type' :: ApiCacheType
$sel:type':CreateApiCache' :: CreateApiCache -> ApiCacheType
type'} -> ApiCacheType
type') (\s :: CreateApiCache
s@CreateApiCache' {} ApiCacheType
a -> CreateApiCache
s {$sel:type':CreateApiCache' :: ApiCacheType
type' = ApiCacheType
a} :: CreateApiCache)

instance Core.AWSRequest CreateApiCache where
  type
    AWSResponse CreateApiCache =
      CreateApiCacheResponse
  request :: (Service -> Service) -> CreateApiCache -> Request CreateApiCache
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateApiCache
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateApiCache)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe ApiCache -> Int -> CreateApiCacheResponse
CreateApiCacheResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"apiCache")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateApiCache where
  hashWithSalt :: Int -> CreateApiCache -> Int
hashWithSalt Int
_salt CreateApiCache' {Integer
Maybe Bool
Text
ApiCacheType
ApiCachingBehavior
type' :: ApiCacheType
apiCachingBehavior :: ApiCachingBehavior
ttl :: Integer
apiId :: Text
transitEncryptionEnabled :: Maybe Bool
atRestEncryptionEnabled :: Maybe Bool
$sel:type':CreateApiCache' :: CreateApiCache -> ApiCacheType
$sel:apiCachingBehavior:CreateApiCache' :: CreateApiCache -> ApiCachingBehavior
$sel:ttl:CreateApiCache' :: CreateApiCache -> Integer
$sel:apiId:CreateApiCache' :: CreateApiCache -> Text
$sel:transitEncryptionEnabled:CreateApiCache' :: CreateApiCache -> Maybe Bool
$sel:atRestEncryptionEnabled:CreateApiCache' :: CreateApiCache -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
atRestEncryptionEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
transitEncryptionEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Integer
ttl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ApiCachingBehavior
apiCachingBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ApiCacheType
type'

instance Prelude.NFData CreateApiCache where
  rnf :: CreateApiCache -> ()
rnf CreateApiCache' {Integer
Maybe Bool
Text
ApiCacheType
ApiCachingBehavior
type' :: ApiCacheType
apiCachingBehavior :: ApiCachingBehavior
ttl :: Integer
apiId :: Text
transitEncryptionEnabled :: Maybe Bool
atRestEncryptionEnabled :: Maybe Bool
$sel:type':CreateApiCache' :: CreateApiCache -> ApiCacheType
$sel:apiCachingBehavior:CreateApiCache' :: CreateApiCache -> ApiCachingBehavior
$sel:ttl:CreateApiCache' :: CreateApiCache -> Integer
$sel:apiId:CreateApiCache' :: CreateApiCache -> Text
$sel:transitEncryptionEnabled:CreateApiCache' :: CreateApiCache -> Maybe Bool
$sel:atRestEncryptionEnabled:CreateApiCache' :: CreateApiCache -> Maybe Bool
..} =
    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 Bool
transitEncryptionEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
apiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
ttl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ApiCachingBehavior
apiCachingBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ApiCacheType
type'

instance Data.ToHeaders CreateApiCache where
  toHeaders :: CreateApiCache -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateApiCache where
  toJSON :: CreateApiCache -> Value
toJSON CreateApiCache' {Integer
Maybe Bool
Text
ApiCacheType
ApiCachingBehavior
type' :: ApiCacheType
apiCachingBehavior :: ApiCachingBehavior
ttl :: Integer
apiId :: Text
transitEncryptionEnabled :: Maybe Bool
atRestEncryptionEnabled :: Maybe Bool
$sel:type':CreateApiCache' :: CreateApiCache -> ApiCacheType
$sel:apiCachingBehavior:CreateApiCache' :: CreateApiCache -> ApiCachingBehavior
$sel:ttl:CreateApiCache' :: CreateApiCache -> Integer
$sel:apiId:CreateApiCache' :: CreateApiCache -> Text
$sel:transitEncryptionEnabled:CreateApiCache' :: CreateApiCache -> Maybe Bool
$sel:atRestEncryptionEnabled:CreateApiCache' :: CreateApiCache -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"atRestEncryptionEnabled" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
atRestEncryptionEnabled,
            (Key
"transitEncryptionEnabled" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
transitEncryptionEnabled,
            forall a. a -> Maybe a
Prelude.Just (Key
"ttl" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Integer
ttl),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"apiCachingBehavior" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ApiCachingBehavior
apiCachingBehavior),
            forall a. a -> Maybe a
Prelude.Just (Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ApiCacheType
type')
          ]
      )

instance Data.ToPath CreateApiCache where
  toPath :: CreateApiCache -> ByteString
toPath CreateApiCache' {Integer
Maybe Bool
Text
ApiCacheType
ApiCachingBehavior
type' :: ApiCacheType
apiCachingBehavior :: ApiCachingBehavior
ttl :: Integer
apiId :: Text
transitEncryptionEnabled :: Maybe Bool
atRestEncryptionEnabled :: Maybe Bool
$sel:type':CreateApiCache' :: CreateApiCache -> ApiCacheType
$sel:apiCachingBehavior:CreateApiCache' :: CreateApiCache -> ApiCachingBehavior
$sel:ttl:CreateApiCache' :: CreateApiCache -> Integer
$sel:apiId:CreateApiCache' :: CreateApiCache -> Text
$sel:transitEncryptionEnabled:CreateApiCache' :: CreateApiCache -> Maybe Bool
$sel:atRestEncryptionEnabled:CreateApiCache' :: CreateApiCache -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/v1/apis/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId, ByteString
"/ApiCaches"]

instance Data.ToQuery CreateApiCache where
  toQuery :: CreateApiCache -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | Represents the output of a @CreateApiCache@ operation.
--
-- /See:/ 'newCreateApiCacheResponse' smart constructor.
data CreateApiCacheResponse = CreateApiCacheResponse'
  { -- | The @ApiCache@ object.
    CreateApiCacheResponse -> Maybe ApiCache
apiCache :: Prelude.Maybe ApiCache,
    -- | The response's http status code.
    CreateApiCacheResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateApiCacheResponse -> CreateApiCacheResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApiCacheResponse -> CreateApiCacheResponse -> Bool
$c/= :: CreateApiCacheResponse -> CreateApiCacheResponse -> Bool
== :: CreateApiCacheResponse -> CreateApiCacheResponse -> Bool
$c== :: CreateApiCacheResponse -> CreateApiCacheResponse -> Bool
Prelude.Eq, ReadPrec [CreateApiCacheResponse]
ReadPrec CreateApiCacheResponse
Int -> ReadS CreateApiCacheResponse
ReadS [CreateApiCacheResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApiCacheResponse]
$creadListPrec :: ReadPrec [CreateApiCacheResponse]
readPrec :: ReadPrec CreateApiCacheResponse
$creadPrec :: ReadPrec CreateApiCacheResponse
readList :: ReadS [CreateApiCacheResponse]
$creadList :: ReadS [CreateApiCacheResponse]
readsPrec :: Int -> ReadS CreateApiCacheResponse
$creadsPrec :: Int -> ReadS CreateApiCacheResponse
Prelude.Read, Int -> CreateApiCacheResponse -> ShowS
[CreateApiCacheResponse] -> ShowS
CreateApiCacheResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApiCacheResponse] -> ShowS
$cshowList :: [CreateApiCacheResponse] -> ShowS
show :: CreateApiCacheResponse -> String
$cshow :: CreateApiCacheResponse -> String
showsPrec :: Int -> CreateApiCacheResponse -> ShowS
$cshowsPrec :: Int -> CreateApiCacheResponse -> ShowS
Prelude.Show, forall x. Rep CreateApiCacheResponse x -> CreateApiCacheResponse
forall x. CreateApiCacheResponse -> Rep CreateApiCacheResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateApiCacheResponse x -> CreateApiCacheResponse
$cfrom :: forall x. CreateApiCacheResponse -> Rep CreateApiCacheResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateApiCacheResponse' 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:
--
-- 'apiCache', 'createApiCacheResponse_apiCache' - The @ApiCache@ object.
--
-- 'httpStatus', 'createApiCacheResponse_httpStatus' - The response's http status code.
newCreateApiCacheResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateApiCacheResponse
newCreateApiCacheResponse :: Int -> CreateApiCacheResponse
newCreateApiCacheResponse Int
pHttpStatus_ =
  CreateApiCacheResponse'
    { $sel:apiCache:CreateApiCacheResponse' :: Maybe ApiCache
apiCache = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateApiCacheResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @ApiCache@ object.
createApiCacheResponse_apiCache :: Lens.Lens' CreateApiCacheResponse (Prelude.Maybe ApiCache)
createApiCacheResponse_apiCache :: Lens' CreateApiCacheResponse (Maybe ApiCache)
createApiCacheResponse_apiCache = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiCacheResponse' {Maybe ApiCache
apiCache :: Maybe ApiCache
$sel:apiCache:CreateApiCacheResponse' :: CreateApiCacheResponse -> Maybe ApiCache
apiCache} -> Maybe ApiCache
apiCache) (\s :: CreateApiCacheResponse
s@CreateApiCacheResponse' {} Maybe ApiCache
a -> CreateApiCacheResponse
s {$sel:apiCache:CreateApiCacheResponse' :: Maybe ApiCache
apiCache = Maybe ApiCache
a} :: CreateApiCacheResponse)

-- | The response's http status code.
createApiCacheResponse_httpStatus :: Lens.Lens' CreateApiCacheResponse Prelude.Int
createApiCacheResponse_httpStatus :: Lens' CreateApiCacheResponse Int
createApiCacheResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiCacheResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateApiCacheResponse' :: CreateApiCacheResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateApiCacheResponse
s@CreateApiCacheResponse' {} Int
a -> CreateApiCacheResponse
s {$sel:httpStatus:CreateApiCacheResponse' :: Int
httpStatus = Int
a} :: CreateApiCacheResponse)

instance Prelude.NFData CreateApiCacheResponse where
  rnf :: CreateApiCacheResponse -> ()
rnf CreateApiCacheResponse' {Int
Maybe ApiCache
httpStatus :: Int
apiCache :: Maybe ApiCache
$sel:httpStatus:CreateApiCacheResponse' :: CreateApiCacheResponse -> Int
$sel:apiCache:CreateApiCacheResponse' :: CreateApiCacheResponse -> Maybe ApiCache
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ApiCache
apiCache
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus