{-# 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.SSMContacts.UpdateContactChannel
-- 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 a contact\'s contact channel.
module Amazonka.SSMContacts.UpdateContactChannel
  ( -- * Creating a Request
    UpdateContactChannel (..),
    newUpdateContactChannel,

    -- * Request Lenses
    updateContactChannel_deliveryAddress,
    updateContactChannel_name,
    updateContactChannel_contactChannelId,

    -- * Destructuring the Response
    UpdateContactChannelResponse (..),
    newUpdateContactChannelResponse,

    -- * Response Lenses
    updateContactChannelResponse_httpStatus,
  )
where

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
import Amazonka.SSMContacts.Types

-- | /See:/ 'newUpdateContactChannel' smart constructor.
data UpdateContactChannel = UpdateContactChannel'
  { -- | The details that Incident Manager uses when trying to engage the contact
    -- channel.
    UpdateContactChannel -> Maybe ContactChannelAddress
deliveryAddress :: Prelude.Maybe ContactChannelAddress,
    -- | The name of the contact channel.
    UpdateContactChannel -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the contact channel you want to
    -- update.
    UpdateContactChannel -> Text
contactChannelId :: Prelude.Text
  }
  deriving (UpdateContactChannel -> UpdateContactChannel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateContactChannel -> UpdateContactChannel -> Bool
$c/= :: UpdateContactChannel -> UpdateContactChannel -> Bool
== :: UpdateContactChannel -> UpdateContactChannel -> Bool
$c== :: UpdateContactChannel -> UpdateContactChannel -> Bool
Prelude.Eq, ReadPrec [UpdateContactChannel]
ReadPrec UpdateContactChannel
Int -> ReadS UpdateContactChannel
ReadS [UpdateContactChannel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateContactChannel]
$creadListPrec :: ReadPrec [UpdateContactChannel]
readPrec :: ReadPrec UpdateContactChannel
$creadPrec :: ReadPrec UpdateContactChannel
readList :: ReadS [UpdateContactChannel]
$creadList :: ReadS [UpdateContactChannel]
readsPrec :: Int -> ReadS UpdateContactChannel
$creadsPrec :: Int -> ReadS UpdateContactChannel
Prelude.Read, Int -> UpdateContactChannel -> ShowS
[UpdateContactChannel] -> ShowS
UpdateContactChannel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateContactChannel] -> ShowS
$cshowList :: [UpdateContactChannel] -> ShowS
show :: UpdateContactChannel -> String
$cshow :: UpdateContactChannel -> String
showsPrec :: Int -> UpdateContactChannel -> ShowS
$cshowsPrec :: Int -> UpdateContactChannel -> ShowS
Prelude.Show, forall x. Rep UpdateContactChannel x -> UpdateContactChannel
forall x. UpdateContactChannel -> Rep UpdateContactChannel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateContactChannel x -> UpdateContactChannel
$cfrom :: forall x. UpdateContactChannel -> Rep UpdateContactChannel x
Prelude.Generic)

-- |
-- Create a value of 'UpdateContactChannel' 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:
--
-- 'deliveryAddress', 'updateContactChannel_deliveryAddress' - The details that Incident Manager uses when trying to engage the contact
-- channel.
--
-- 'name', 'updateContactChannel_name' - The name of the contact channel.
--
-- 'contactChannelId', 'updateContactChannel_contactChannelId' - The Amazon Resource Name (ARN) of the contact channel you want to
-- update.
newUpdateContactChannel ::
  -- | 'contactChannelId'
  Prelude.Text ->
  UpdateContactChannel
newUpdateContactChannel :: Text -> UpdateContactChannel
newUpdateContactChannel Text
pContactChannelId_ =
  UpdateContactChannel'
    { $sel:deliveryAddress:UpdateContactChannel' :: Maybe ContactChannelAddress
deliveryAddress =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateContactChannel' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:contactChannelId:UpdateContactChannel' :: Text
contactChannelId = Text
pContactChannelId_
    }

-- | The details that Incident Manager uses when trying to engage the contact
-- channel.
updateContactChannel_deliveryAddress :: Lens.Lens' UpdateContactChannel (Prelude.Maybe ContactChannelAddress)
updateContactChannel_deliveryAddress :: Lens' UpdateContactChannel (Maybe ContactChannelAddress)
updateContactChannel_deliveryAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContactChannel' {Maybe ContactChannelAddress
deliveryAddress :: Maybe ContactChannelAddress
$sel:deliveryAddress:UpdateContactChannel' :: UpdateContactChannel -> Maybe ContactChannelAddress
deliveryAddress} -> Maybe ContactChannelAddress
deliveryAddress) (\s :: UpdateContactChannel
s@UpdateContactChannel' {} Maybe ContactChannelAddress
a -> UpdateContactChannel
s {$sel:deliveryAddress:UpdateContactChannel' :: Maybe ContactChannelAddress
deliveryAddress = Maybe ContactChannelAddress
a} :: UpdateContactChannel)

-- | The name of the contact channel.
updateContactChannel_name :: Lens.Lens' UpdateContactChannel (Prelude.Maybe Prelude.Text)
updateContactChannel_name :: Lens' UpdateContactChannel (Maybe Text)
updateContactChannel_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContactChannel' {Maybe Text
name :: Maybe Text
$sel:name:UpdateContactChannel' :: UpdateContactChannel -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateContactChannel
s@UpdateContactChannel' {} Maybe Text
a -> UpdateContactChannel
s {$sel:name:UpdateContactChannel' :: Maybe Text
name = Maybe Text
a} :: UpdateContactChannel)

-- | The Amazon Resource Name (ARN) of the contact channel you want to
-- update.
updateContactChannel_contactChannelId :: Lens.Lens' UpdateContactChannel Prelude.Text
updateContactChannel_contactChannelId :: Lens' UpdateContactChannel Text
updateContactChannel_contactChannelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContactChannel' {Text
contactChannelId :: Text
$sel:contactChannelId:UpdateContactChannel' :: UpdateContactChannel -> Text
contactChannelId} -> Text
contactChannelId) (\s :: UpdateContactChannel
s@UpdateContactChannel' {} Text
a -> UpdateContactChannel
s {$sel:contactChannelId:UpdateContactChannel' :: Text
contactChannelId = Text
a} :: UpdateContactChannel)

instance Core.AWSRequest UpdateContactChannel where
  type
    AWSResponse UpdateContactChannel =
      UpdateContactChannelResponse
  request :: (Service -> Service)
-> UpdateContactChannel -> Request UpdateContactChannel
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 UpdateContactChannel
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateContactChannel)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateContactChannelResponse
UpdateContactChannelResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateContactChannel where
  hashWithSalt :: Int -> UpdateContactChannel -> Int
hashWithSalt Int
_salt UpdateContactChannel' {Maybe Text
Maybe ContactChannelAddress
Text
contactChannelId :: Text
name :: Maybe Text
deliveryAddress :: Maybe ContactChannelAddress
$sel:contactChannelId:UpdateContactChannel' :: UpdateContactChannel -> Text
$sel:name:UpdateContactChannel' :: UpdateContactChannel -> Maybe Text
$sel:deliveryAddress:UpdateContactChannel' :: UpdateContactChannel -> Maybe ContactChannelAddress
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContactChannelAddress
deliveryAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactChannelId

instance Prelude.NFData UpdateContactChannel where
  rnf :: UpdateContactChannel -> ()
rnf UpdateContactChannel' {Maybe Text
Maybe ContactChannelAddress
Text
contactChannelId :: Text
name :: Maybe Text
deliveryAddress :: Maybe ContactChannelAddress
$sel:contactChannelId:UpdateContactChannel' :: UpdateContactChannel -> Text
$sel:name:UpdateContactChannel' :: UpdateContactChannel -> Maybe Text
$sel:deliveryAddress:UpdateContactChannel' :: UpdateContactChannel -> Maybe ContactChannelAddress
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ContactChannelAddress
deliveryAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contactChannelId

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

instance Data.ToJSON UpdateContactChannel where
  toJSON :: UpdateContactChannel -> Value
toJSON UpdateContactChannel' {Maybe Text
Maybe ContactChannelAddress
Text
contactChannelId :: Text
name :: Maybe Text
deliveryAddress :: Maybe ContactChannelAddress
$sel:contactChannelId:UpdateContactChannel' :: UpdateContactChannel -> Text
$sel:name:UpdateContactChannel' :: UpdateContactChannel -> Maybe Text
$sel:deliveryAddress:UpdateContactChannel' :: UpdateContactChannel -> Maybe ContactChannelAddress
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeliveryAddress" 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 ContactChannelAddress
deliveryAddress,
            (Key
"Name" 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 Text
name,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ContactChannelId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
contactChannelId)
          ]
      )

instance Data.ToPath UpdateContactChannel where
  toPath :: UpdateContactChannel -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'UpdateContactChannelResponse' 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:
--
-- 'httpStatus', 'updateContactChannelResponse_httpStatus' - The response's http status code.
newUpdateContactChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateContactChannelResponse
newUpdateContactChannelResponse :: Int -> UpdateContactChannelResponse
newUpdateContactChannelResponse Int
pHttpStatus_ =
  UpdateContactChannelResponse'
    { $sel:httpStatus:UpdateContactChannelResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdateContactChannelResponse where
  rnf :: UpdateContactChannelResponse -> ()
rnf UpdateContactChannelResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateContactChannelResponse' :: UpdateContactChannelResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus