{-# 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.ApiGatewayV2.ResetAuthorizersCache
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Resets all authorizer cache entries on a stage. Supported only for HTTP
-- APIs.
module Amazonka.ApiGatewayV2.ResetAuthorizersCache
  ( -- * Creating a Request
    ResetAuthorizersCache (..),
    newResetAuthorizersCache,

    -- * Request Lenses
    resetAuthorizersCache_stageName,
    resetAuthorizersCache_apiId,

    -- * Destructuring the Response
    ResetAuthorizersCacheResponse (..),
    newResetAuthorizersCacheResponse,
  )
where

import Amazonka.ApiGatewayV2.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

-- | /See:/ 'newResetAuthorizersCache' smart constructor.
data ResetAuthorizersCache = ResetAuthorizersCache'
  { -- | The stage name. Stage names can contain only alphanumeric characters,
    -- hyphens, and underscores, or be $default. Maximum length is 128
    -- characters.
    ResetAuthorizersCache -> Text
stageName :: Prelude.Text,
    -- | The API identifier.
    ResetAuthorizersCache -> Text
apiId :: Prelude.Text
  }
  deriving (ResetAuthorizersCache -> ResetAuthorizersCache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetAuthorizersCache -> ResetAuthorizersCache -> Bool
$c/= :: ResetAuthorizersCache -> ResetAuthorizersCache -> Bool
== :: ResetAuthorizersCache -> ResetAuthorizersCache -> Bool
$c== :: ResetAuthorizersCache -> ResetAuthorizersCache -> Bool
Prelude.Eq, ReadPrec [ResetAuthorizersCache]
ReadPrec ResetAuthorizersCache
Int -> ReadS ResetAuthorizersCache
ReadS [ResetAuthorizersCache]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetAuthorizersCache]
$creadListPrec :: ReadPrec [ResetAuthorizersCache]
readPrec :: ReadPrec ResetAuthorizersCache
$creadPrec :: ReadPrec ResetAuthorizersCache
readList :: ReadS [ResetAuthorizersCache]
$creadList :: ReadS [ResetAuthorizersCache]
readsPrec :: Int -> ReadS ResetAuthorizersCache
$creadsPrec :: Int -> ReadS ResetAuthorizersCache
Prelude.Read, Int -> ResetAuthorizersCache -> ShowS
[ResetAuthorizersCache] -> ShowS
ResetAuthorizersCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetAuthorizersCache] -> ShowS
$cshowList :: [ResetAuthorizersCache] -> ShowS
show :: ResetAuthorizersCache -> String
$cshow :: ResetAuthorizersCache -> String
showsPrec :: Int -> ResetAuthorizersCache -> ShowS
$cshowsPrec :: Int -> ResetAuthorizersCache -> ShowS
Prelude.Show, forall x. Rep ResetAuthorizersCache x -> ResetAuthorizersCache
forall x. ResetAuthorizersCache -> Rep ResetAuthorizersCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResetAuthorizersCache x -> ResetAuthorizersCache
$cfrom :: forall x. ResetAuthorizersCache -> Rep ResetAuthorizersCache x
Prelude.Generic)

-- |
-- Create a value of 'ResetAuthorizersCache' 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:
--
-- 'stageName', 'resetAuthorizersCache_stageName' - The stage name. Stage names can contain only alphanumeric characters,
-- hyphens, and underscores, or be $default. Maximum length is 128
-- characters.
--
-- 'apiId', 'resetAuthorizersCache_apiId' - The API identifier.
newResetAuthorizersCache ::
  -- | 'stageName'
  Prelude.Text ->
  -- | 'apiId'
  Prelude.Text ->
  ResetAuthorizersCache
newResetAuthorizersCache :: Text -> Text -> ResetAuthorizersCache
newResetAuthorizersCache Text
pStageName_ Text
pApiId_ =
  ResetAuthorizersCache'
    { $sel:stageName:ResetAuthorizersCache' :: Text
stageName = Text
pStageName_,
      $sel:apiId:ResetAuthorizersCache' :: Text
apiId = Text
pApiId_
    }

-- | The stage name. Stage names can contain only alphanumeric characters,
-- hyphens, and underscores, or be $default. Maximum length is 128
-- characters.
resetAuthorizersCache_stageName :: Lens.Lens' ResetAuthorizersCache Prelude.Text
resetAuthorizersCache_stageName :: Lens' ResetAuthorizersCache Text
resetAuthorizersCache_stageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetAuthorizersCache' {Text
stageName :: Text
$sel:stageName:ResetAuthorizersCache' :: ResetAuthorizersCache -> Text
stageName} -> Text
stageName) (\s :: ResetAuthorizersCache
s@ResetAuthorizersCache' {} Text
a -> ResetAuthorizersCache
s {$sel:stageName:ResetAuthorizersCache' :: Text
stageName = Text
a} :: ResetAuthorizersCache)

-- | The API identifier.
resetAuthorizersCache_apiId :: Lens.Lens' ResetAuthorizersCache Prelude.Text
resetAuthorizersCache_apiId :: Lens' ResetAuthorizersCache Text
resetAuthorizersCache_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetAuthorizersCache' {Text
apiId :: Text
$sel:apiId:ResetAuthorizersCache' :: ResetAuthorizersCache -> Text
apiId} -> Text
apiId) (\s :: ResetAuthorizersCache
s@ResetAuthorizersCache' {} Text
a -> ResetAuthorizersCache
s {$sel:apiId:ResetAuthorizersCache' :: Text
apiId = Text
a} :: ResetAuthorizersCache)

instance Core.AWSRequest ResetAuthorizersCache where
  type
    AWSResponse ResetAuthorizersCache =
      ResetAuthorizersCacheResponse
  request :: (Service -> Service)
-> ResetAuthorizersCache -> Request ResetAuthorizersCache
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ResetAuthorizersCache
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ResetAuthorizersCache)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull ResetAuthorizersCacheResponse
ResetAuthorizersCacheResponse'

instance Prelude.Hashable ResetAuthorizersCache where
  hashWithSalt :: Int -> ResetAuthorizersCache -> Int
hashWithSalt Int
_salt ResetAuthorizersCache' {Text
apiId :: Text
stageName :: Text
$sel:apiId:ResetAuthorizersCache' :: ResetAuthorizersCache -> Text
$sel:stageName:ResetAuthorizersCache' :: ResetAuthorizersCache -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stageName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId

instance Prelude.NFData ResetAuthorizersCache where
  rnf :: ResetAuthorizersCache -> ()
rnf ResetAuthorizersCache' {Text
apiId :: Text
stageName :: Text
$sel:apiId:ResetAuthorizersCache' :: ResetAuthorizersCache -> Text
$sel:stageName:ResetAuthorizersCache' :: ResetAuthorizersCache -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
stageName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
apiId

instance Data.ToHeaders ResetAuthorizersCache where
  toHeaders :: ResetAuthorizersCache -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath ResetAuthorizersCache where
  toPath :: ResetAuthorizersCache -> ByteString
toPath ResetAuthorizersCache' {Text
apiId :: Text
stageName :: Text
$sel:apiId:ResetAuthorizersCache' :: ResetAuthorizersCache -> Text
$sel:stageName:ResetAuthorizersCache' :: ResetAuthorizersCache -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v2/apis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId,
        ByteString
"/stages/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
stageName,
        ByteString
"/cache/authorizers"
      ]

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

-- | /See:/ 'newResetAuthorizersCacheResponse' smart constructor.
data ResetAuthorizersCacheResponse = ResetAuthorizersCacheResponse'
  {
  }
  deriving (ResetAuthorizersCacheResponse
-> ResetAuthorizersCacheResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetAuthorizersCacheResponse
-> ResetAuthorizersCacheResponse -> Bool
$c/= :: ResetAuthorizersCacheResponse
-> ResetAuthorizersCacheResponse -> Bool
== :: ResetAuthorizersCacheResponse
-> ResetAuthorizersCacheResponse -> Bool
$c== :: ResetAuthorizersCacheResponse
-> ResetAuthorizersCacheResponse -> Bool
Prelude.Eq, ReadPrec [ResetAuthorizersCacheResponse]
ReadPrec ResetAuthorizersCacheResponse
Int -> ReadS ResetAuthorizersCacheResponse
ReadS [ResetAuthorizersCacheResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetAuthorizersCacheResponse]
$creadListPrec :: ReadPrec [ResetAuthorizersCacheResponse]
readPrec :: ReadPrec ResetAuthorizersCacheResponse
$creadPrec :: ReadPrec ResetAuthorizersCacheResponse
readList :: ReadS [ResetAuthorizersCacheResponse]
$creadList :: ReadS [ResetAuthorizersCacheResponse]
readsPrec :: Int -> ReadS ResetAuthorizersCacheResponse
$creadsPrec :: Int -> ReadS ResetAuthorizersCacheResponse
Prelude.Read, Int -> ResetAuthorizersCacheResponse -> ShowS
[ResetAuthorizersCacheResponse] -> ShowS
ResetAuthorizersCacheResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetAuthorizersCacheResponse] -> ShowS
$cshowList :: [ResetAuthorizersCacheResponse] -> ShowS
show :: ResetAuthorizersCacheResponse -> String
$cshow :: ResetAuthorizersCacheResponse -> String
showsPrec :: Int -> ResetAuthorizersCacheResponse -> ShowS
$cshowsPrec :: Int -> ResetAuthorizersCacheResponse -> ShowS
Prelude.Show, forall x.
Rep ResetAuthorizersCacheResponse x
-> ResetAuthorizersCacheResponse
forall x.
ResetAuthorizersCacheResponse
-> Rep ResetAuthorizersCacheResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ResetAuthorizersCacheResponse x
-> ResetAuthorizersCacheResponse
$cfrom :: forall x.
ResetAuthorizersCacheResponse
-> Rep ResetAuthorizersCacheResponse x
Prelude.Generic)

-- |
-- Create a value of 'ResetAuthorizersCacheResponse' 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.
newResetAuthorizersCacheResponse ::
  ResetAuthorizersCacheResponse
newResetAuthorizersCacheResponse :: ResetAuthorizersCacheResponse
newResetAuthorizersCacheResponse =
  ResetAuthorizersCacheResponse
ResetAuthorizersCacheResponse'

instance Prelude.NFData ResetAuthorizersCacheResponse where
  rnf :: ResetAuthorizersCacheResponse -> ()
rnf ResetAuthorizersCacheResponse
_ = ()