{-# 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.APIGateway.UpdateMethodResponse
-- 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 an existing MethodResponse resource.
module Amazonka.APIGateway.UpdateMethodResponse
  ( -- * Creating a Request
    UpdateMethodResponse (..),
    newUpdateMethodResponse,

    -- * Request Lenses
    updateMethodResponse_patchOperations,
    updateMethodResponse_restApiId,
    updateMethodResponse_resourceId,
    updateMethodResponse_httpMethod,
    updateMethodResponse_statusCode,

    -- * Destructuring the Response
    MethodResponse (..),
    newMethodResponse,

    -- * Response Lenses
    methodResponse_responseModels,
    methodResponse_responseParameters,
    methodResponse_statusCode,
  )
where

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

-- | A request to update an existing MethodResponse resource.
--
-- /See:/ 'newUpdateMethodResponse' smart constructor.
data UpdateMethodResponse = UpdateMethodResponse'
  { -- | For more information about supported patch operations, see
    -- <https://docs.aws.amazon.com/apigateway/latest/api/patch-operations.html Patch Operations>.
    UpdateMethodResponse -> Maybe [PatchOperation]
patchOperations :: Prelude.Maybe [PatchOperation],
    -- | The string identifier of the associated RestApi.
    UpdateMethodResponse -> Text
restApiId :: Prelude.Text,
    -- | The Resource identifier for the MethodResponse resource.
    UpdateMethodResponse -> Text
resourceId :: Prelude.Text,
    -- | The HTTP verb of the Method resource.
    UpdateMethodResponse -> Text
httpMethod :: Prelude.Text,
    -- | The status code for the MethodResponse resource.
    UpdateMethodResponse -> Text
statusCode :: Prelude.Text
  }
  deriving (UpdateMethodResponse -> UpdateMethodResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMethodResponse -> UpdateMethodResponse -> Bool
$c/= :: UpdateMethodResponse -> UpdateMethodResponse -> Bool
== :: UpdateMethodResponse -> UpdateMethodResponse -> Bool
$c== :: UpdateMethodResponse -> UpdateMethodResponse -> Bool
Prelude.Eq, ReadPrec [UpdateMethodResponse]
ReadPrec UpdateMethodResponse
Int -> ReadS UpdateMethodResponse
ReadS [UpdateMethodResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMethodResponse]
$creadListPrec :: ReadPrec [UpdateMethodResponse]
readPrec :: ReadPrec UpdateMethodResponse
$creadPrec :: ReadPrec UpdateMethodResponse
readList :: ReadS [UpdateMethodResponse]
$creadList :: ReadS [UpdateMethodResponse]
readsPrec :: Int -> ReadS UpdateMethodResponse
$creadsPrec :: Int -> ReadS UpdateMethodResponse
Prelude.Read, Int -> UpdateMethodResponse -> ShowS
[UpdateMethodResponse] -> ShowS
UpdateMethodResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMethodResponse] -> ShowS
$cshowList :: [UpdateMethodResponse] -> ShowS
show :: UpdateMethodResponse -> String
$cshow :: UpdateMethodResponse -> String
showsPrec :: Int -> UpdateMethodResponse -> ShowS
$cshowsPrec :: Int -> UpdateMethodResponse -> ShowS
Prelude.Show, forall x. Rep UpdateMethodResponse x -> UpdateMethodResponse
forall x. UpdateMethodResponse -> Rep UpdateMethodResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateMethodResponse x -> UpdateMethodResponse
$cfrom :: forall x. UpdateMethodResponse -> Rep UpdateMethodResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMethodResponse' 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:
--
-- 'patchOperations', 'updateMethodResponse_patchOperations' - For more information about supported patch operations, see
-- <https://docs.aws.amazon.com/apigateway/latest/api/patch-operations.html Patch Operations>.
--
-- 'restApiId', 'updateMethodResponse_restApiId' - The string identifier of the associated RestApi.
--
-- 'resourceId', 'updateMethodResponse_resourceId' - The Resource identifier for the MethodResponse resource.
--
-- 'httpMethod', 'updateMethodResponse_httpMethod' - The HTTP verb of the Method resource.
--
-- 'statusCode', 'updateMethodResponse_statusCode' - The status code for the MethodResponse resource.
newUpdateMethodResponse ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'httpMethod'
  Prelude.Text ->
  -- | 'statusCode'
  Prelude.Text ->
  UpdateMethodResponse
newUpdateMethodResponse :: Text -> Text -> Text -> Text -> UpdateMethodResponse
newUpdateMethodResponse
  Text
pRestApiId_
  Text
pResourceId_
  Text
pHttpMethod_
  Text
pStatusCode_ =
    UpdateMethodResponse'
      { $sel:patchOperations:UpdateMethodResponse' :: Maybe [PatchOperation]
patchOperations =
          forall a. Maybe a
Prelude.Nothing,
        $sel:restApiId:UpdateMethodResponse' :: Text
restApiId = Text
pRestApiId_,
        $sel:resourceId:UpdateMethodResponse' :: Text
resourceId = Text
pResourceId_,
        $sel:httpMethod:UpdateMethodResponse' :: Text
httpMethod = Text
pHttpMethod_,
        $sel:statusCode:UpdateMethodResponse' :: Text
statusCode = Text
pStatusCode_
      }

-- | For more information about supported patch operations, see
-- <https://docs.aws.amazon.com/apigateway/latest/api/patch-operations.html Patch Operations>.
updateMethodResponse_patchOperations :: Lens.Lens' UpdateMethodResponse (Prelude.Maybe [PatchOperation])
updateMethodResponse_patchOperations :: Lens' UpdateMethodResponse (Maybe [PatchOperation])
updateMethodResponse_patchOperations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMethodResponse' {Maybe [PatchOperation]
patchOperations :: Maybe [PatchOperation]
$sel:patchOperations:UpdateMethodResponse' :: UpdateMethodResponse -> Maybe [PatchOperation]
patchOperations} -> Maybe [PatchOperation]
patchOperations) (\s :: UpdateMethodResponse
s@UpdateMethodResponse' {} Maybe [PatchOperation]
a -> UpdateMethodResponse
s {$sel:patchOperations:UpdateMethodResponse' :: Maybe [PatchOperation]
patchOperations = Maybe [PatchOperation]
a} :: UpdateMethodResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The string identifier of the associated RestApi.
updateMethodResponse_restApiId :: Lens.Lens' UpdateMethodResponse Prelude.Text
updateMethodResponse_restApiId :: Lens' UpdateMethodResponse Text
updateMethodResponse_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMethodResponse' {Text
restApiId :: Text
$sel:restApiId:UpdateMethodResponse' :: UpdateMethodResponse -> Text
restApiId} -> Text
restApiId) (\s :: UpdateMethodResponse
s@UpdateMethodResponse' {} Text
a -> UpdateMethodResponse
s {$sel:restApiId:UpdateMethodResponse' :: Text
restApiId = Text
a} :: UpdateMethodResponse)

-- | The Resource identifier for the MethodResponse resource.
updateMethodResponse_resourceId :: Lens.Lens' UpdateMethodResponse Prelude.Text
updateMethodResponse_resourceId :: Lens' UpdateMethodResponse Text
updateMethodResponse_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMethodResponse' {Text
resourceId :: Text
$sel:resourceId:UpdateMethodResponse' :: UpdateMethodResponse -> Text
resourceId} -> Text
resourceId) (\s :: UpdateMethodResponse
s@UpdateMethodResponse' {} Text
a -> UpdateMethodResponse
s {$sel:resourceId:UpdateMethodResponse' :: Text
resourceId = Text
a} :: UpdateMethodResponse)

-- | The HTTP verb of the Method resource.
updateMethodResponse_httpMethod :: Lens.Lens' UpdateMethodResponse Prelude.Text
updateMethodResponse_httpMethod :: Lens' UpdateMethodResponse Text
updateMethodResponse_httpMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMethodResponse' {Text
httpMethod :: Text
$sel:httpMethod:UpdateMethodResponse' :: UpdateMethodResponse -> Text
httpMethod} -> Text
httpMethod) (\s :: UpdateMethodResponse
s@UpdateMethodResponse' {} Text
a -> UpdateMethodResponse
s {$sel:httpMethod:UpdateMethodResponse' :: Text
httpMethod = Text
a} :: UpdateMethodResponse)

-- | The status code for the MethodResponse resource.
updateMethodResponse_statusCode :: Lens.Lens' UpdateMethodResponse Prelude.Text
updateMethodResponse_statusCode :: Lens' UpdateMethodResponse Text
updateMethodResponse_statusCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMethodResponse' {Text
statusCode :: Text
$sel:statusCode:UpdateMethodResponse' :: UpdateMethodResponse -> Text
statusCode} -> Text
statusCode) (\s :: UpdateMethodResponse
s@UpdateMethodResponse' {} Text
a -> UpdateMethodResponse
s {$sel:statusCode:UpdateMethodResponse' :: Text
statusCode = Text
a} :: UpdateMethodResponse)

instance Core.AWSRequest UpdateMethodResponse where
  type
    AWSResponse UpdateMethodResponse =
      MethodResponse
  request :: (Service -> Service)
-> UpdateMethodResponse -> Request UpdateMethodResponse
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateMethodResponse
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateMethodResponse)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable UpdateMethodResponse where
  hashWithSalt :: Int -> UpdateMethodResponse -> Int
hashWithSalt Int
_salt UpdateMethodResponse' {Maybe [PatchOperation]
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
patchOperations :: Maybe [PatchOperation]
$sel:statusCode:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:httpMethod:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:resourceId:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:restApiId:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:patchOperations:UpdateMethodResponse' :: UpdateMethodResponse -> Maybe [PatchOperation]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PatchOperation]
patchOperations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
httpMethod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
statusCode

instance Prelude.NFData UpdateMethodResponse where
  rnf :: UpdateMethodResponse -> ()
rnf UpdateMethodResponse' {Maybe [PatchOperation]
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
patchOperations :: Maybe [PatchOperation]
$sel:statusCode:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:httpMethod:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:resourceId:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:restApiId:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:patchOperations:UpdateMethodResponse' :: UpdateMethodResponse -> Maybe [PatchOperation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [PatchOperation]
patchOperations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
restApiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
httpMethod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
statusCode

instance Data.ToHeaders UpdateMethodResponse where
  toHeaders :: UpdateMethodResponse -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Accept"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
          ]
      )

instance Data.ToJSON UpdateMethodResponse where
  toJSON :: UpdateMethodResponse -> Value
toJSON UpdateMethodResponse' {Maybe [PatchOperation]
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
patchOperations :: Maybe [PatchOperation]
$sel:statusCode:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:httpMethod:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:resourceId:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:restApiId:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:patchOperations:UpdateMethodResponse' :: UpdateMethodResponse -> Maybe [PatchOperation]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"patchOperations" 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 [PatchOperation]
patchOperations
          ]
      )

instance Data.ToPath UpdateMethodResponse where
  toPath :: UpdateMethodResponse -> ByteString
toPath UpdateMethodResponse' {Maybe [PatchOperation]
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
patchOperations :: Maybe [PatchOperation]
$sel:statusCode:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:httpMethod:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:resourceId:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:restApiId:UpdateMethodResponse' :: UpdateMethodResponse -> Text
$sel:patchOperations:UpdateMethodResponse' :: UpdateMethodResponse -> Maybe [PatchOperation]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/restapis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId,
        ByteString
"/resources/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
resourceId,
        ByteString
"/methods/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
httpMethod,
        ByteString
"/responses/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
statusCode
      ]

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