{-# 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.UpdateApiCache
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the cache for the GraphQL API.
module Amazonka.AppSync.UpdateApiCache
  ( -- * Creating a Request
    UpdateApiCache (..),
    newUpdateApiCache,

    -- * Request Lenses
    updateApiCache_apiId,
    updateApiCache_ttl,
    updateApiCache_apiCachingBehavior,
    updateApiCache_type,

    -- * Destructuring the Response
    UpdateApiCacheResponse (..),
    newUpdateApiCacheResponse,

    -- * Response Lenses
    updateApiCacheResponse_apiCache,
    updateApiCacheResponse_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 @UpdateApiCache@ operation.
--
-- /See:/ 'newUpdateApiCache' smart constructor.
data UpdateApiCache = UpdateApiCache'
  { -- | The GraphQL API ID.
    UpdateApiCache -> Text
apiId :: Prelude.Text,
    -- | TTL in seconds for cache entries.
    --
    -- Valid values are 1–3,600 seconds.
    UpdateApiCache -> Integer
ttl :: Prelude.Integer,
    -- | Caching behavior.
    --
    -- -   __FULL_REQUEST_CACHING__: All requests are fully cached.
    --
    -- -   __PER_RESOLVER_CACHING__: Individual resolvers that you specify are
    --     cached.
    UpdateApiCache -> 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.
    UpdateApiCache -> ApiCacheType
type' :: ApiCacheType
  }
  deriving (UpdateApiCache -> UpdateApiCache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateApiCache -> UpdateApiCache -> Bool
$c/= :: UpdateApiCache -> UpdateApiCache -> Bool
== :: UpdateApiCache -> UpdateApiCache -> Bool
$c== :: UpdateApiCache -> UpdateApiCache -> Bool
Prelude.Eq, ReadPrec [UpdateApiCache]
ReadPrec UpdateApiCache
Int -> ReadS UpdateApiCache
ReadS [UpdateApiCache]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateApiCache]
$creadListPrec :: ReadPrec [UpdateApiCache]
readPrec :: ReadPrec UpdateApiCache
$creadPrec :: ReadPrec UpdateApiCache
readList :: ReadS [UpdateApiCache]
$creadList :: ReadS [UpdateApiCache]
readsPrec :: Int -> ReadS UpdateApiCache
$creadsPrec :: Int -> ReadS UpdateApiCache
Prelude.Read, Int -> UpdateApiCache -> ShowS
[UpdateApiCache] -> ShowS
UpdateApiCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateApiCache] -> ShowS
$cshowList :: [UpdateApiCache] -> ShowS
show :: UpdateApiCache -> String
$cshow :: UpdateApiCache -> String
showsPrec :: Int -> UpdateApiCache -> ShowS
$cshowsPrec :: Int -> UpdateApiCache -> ShowS
Prelude.Show, forall x. Rep UpdateApiCache x -> UpdateApiCache
forall x. UpdateApiCache -> Rep UpdateApiCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateApiCache x -> UpdateApiCache
$cfrom :: forall x. UpdateApiCache -> Rep UpdateApiCache x
Prelude.Generic)

-- |
-- Create a value of 'UpdateApiCache' 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:
--
-- 'apiId', 'updateApiCache_apiId' - The GraphQL API ID.
--
-- 'ttl', 'updateApiCache_ttl' - TTL in seconds for cache entries.
--
-- Valid values are 1–3,600 seconds.
--
-- 'apiCachingBehavior', 'updateApiCache_apiCachingBehavior' - Caching behavior.
--
-- -   __FULL_REQUEST_CACHING__: All requests are fully cached.
--
-- -   __PER_RESOLVER_CACHING__: Individual resolvers that you specify are
--     cached.
--
-- 'type'', 'updateApiCache_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.
newUpdateApiCache ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'ttl'
  Prelude.Integer ->
  -- | 'apiCachingBehavior'
  ApiCachingBehavior ->
  -- | 'type''
  ApiCacheType ->
  UpdateApiCache
newUpdateApiCache :: Text
-> Integer -> ApiCachingBehavior -> ApiCacheType -> UpdateApiCache
newUpdateApiCache
  Text
pApiId_
  Integer
pTtl_
  ApiCachingBehavior
pApiCachingBehavior_
  ApiCacheType
pType_ =
    UpdateApiCache'
      { $sel:apiId:UpdateApiCache' :: Text
apiId = Text
pApiId_,
        $sel:ttl:UpdateApiCache' :: Integer
ttl = Integer
pTtl_,
        $sel:apiCachingBehavior:UpdateApiCache' :: ApiCachingBehavior
apiCachingBehavior = ApiCachingBehavior
pApiCachingBehavior_,
        $sel:type':UpdateApiCache' :: ApiCacheType
type' = ApiCacheType
pType_
      }

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

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

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

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

instance Core.AWSRequest UpdateApiCache where
  type
    AWSResponse UpdateApiCache =
      UpdateApiCacheResponse
  request :: (Service -> Service) -> UpdateApiCache -> Request UpdateApiCache
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 UpdateApiCache
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateApiCache)))
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 -> UpdateApiCacheResponse
UpdateApiCacheResponse'
            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 UpdateApiCache where
  hashWithSalt :: Int -> UpdateApiCache -> Int
hashWithSalt Int
_salt UpdateApiCache' {Integer
Text
ApiCacheType
ApiCachingBehavior
type' :: ApiCacheType
apiCachingBehavior :: ApiCachingBehavior
ttl :: Integer
apiId :: Text
$sel:type':UpdateApiCache' :: UpdateApiCache -> ApiCacheType
$sel:apiCachingBehavior:UpdateApiCache' :: UpdateApiCache -> ApiCachingBehavior
$sel:ttl:UpdateApiCache' :: UpdateApiCache -> Integer
$sel:apiId:UpdateApiCache' :: UpdateApiCache -> Text
..} =
    Int
_salt
      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 UpdateApiCache where
  rnf :: UpdateApiCache -> ()
rnf UpdateApiCache' {Integer
Text
ApiCacheType
ApiCachingBehavior
type' :: ApiCacheType
apiCachingBehavior :: ApiCachingBehavior
ttl :: Integer
apiId :: Text
$sel:type':UpdateApiCache' :: UpdateApiCache -> ApiCacheType
$sel:apiCachingBehavior:UpdateApiCache' :: UpdateApiCache -> ApiCachingBehavior
$sel:ttl:UpdateApiCache' :: UpdateApiCache -> Integer
$sel:apiId:UpdateApiCache' :: UpdateApiCache -> Text
..} =
    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 UpdateApiCache where
  toHeaders :: UpdateApiCache -> 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 UpdateApiCache where
  toJSON :: UpdateApiCache -> Value
toJSON UpdateApiCache' {Integer
Text
ApiCacheType
ApiCachingBehavior
type' :: ApiCacheType
apiCachingBehavior :: ApiCachingBehavior
ttl :: Integer
apiId :: Text
$sel:type':UpdateApiCache' :: UpdateApiCache -> ApiCacheType
$sel:apiCachingBehavior:UpdateApiCache' :: UpdateApiCache -> ApiCachingBehavior
$sel:ttl:UpdateApiCache' :: UpdateApiCache -> Integer
$sel:apiId:UpdateApiCache' :: UpdateApiCache -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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 UpdateApiCache where
  toPath :: UpdateApiCache -> ByteString
toPath UpdateApiCache' {Integer
Text
ApiCacheType
ApiCachingBehavior
type' :: ApiCacheType
apiCachingBehavior :: ApiCachingBehavior
ttl :: Integer
apiId :: Text
$sel:type':UpdateApiCache' :: UpdateApiCache -> ApiCacheType
$sel:apiCachingBehavior:UpdateApiCache' :: UpdateApiCache -> ApiCachingBehavior
$sel:ttl:UpdateApiCache' :: UpdateApiCache -> Integer
$sel:apiId:UpdateApiCache' :: UpdateApiCache -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/v1/apis/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId, ByteString
"/ApiCaches/update"]

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

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

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

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

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

instance Prelude.NFData UpdateApiCacheResponse where
  rnf :: UpdateApiCacheResponse -> ()
rnf UpdateApiCacheResponse' {Int
Maybe ApiCache
httpStatus :: Int
apiCache :: Maybe ApiCache
$sel:httpStatus:UpdateApiCacheResponse' :: UpdateApiCacheResponse -> Int
$sel:apiCache:UpdateApiCacheResponse' :: UpdateApiCacheResponse -> 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