{-# 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.SSMIncidents.UpdateIncidentRecord
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update the details of an incident record. You can use this operation to
-- update an incident record from the defined chat channel. For more
-- information about using actions in chat channels, see
-- <https://docs.aws.amazon.com/incident-manager/latest/userguide/chat.html#chat-interact Interacting through chat>.
module Amazonka.SSMIncidents.UpdateIncidentRecord
  ( -- * Creating a Request
    UpdateIncidentRecord (..),
    newUpdateIncidentRecord,

    -- * Request Lenses
    updateIncidentRecord_chatChannel,
    updateIncidentRecord_clientToken,
    updateIncidentRecord_impact,
    updateIncidentRecord_notificationTargets,
    updateIncidentRecord_status,
    updateIncidentRecord_summary,
    updateIncidentRecord_title,
    updateIncidentRecord_arn,

    -- * Destructuring the Response
    UpdateIncidentRecordResponse (..),
    newUpdateIncidentRecordResponse,

    -- * Response Lenses
    updateIncidentRecordResponse_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.SSMIncidents.Types

-- | /See:/ 'newUpdateIncidentRecord' smart constructor.
data UpdateIncidentRecord = UpdateIncidentRecord'
  { -- | The Chatbot chat channel where responders can collaborate.
    UpdateIncidentRecord -> Maybe ChatChannel
chatChannel :: Prelude.Maybe ChatChannel,
    -- | A token that ensures that the operation is called only once with the
    -- specified details.
    UpdateIncidentRecord -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Defines the impact of the incident to customers and applications.
    -- Providing an impact overwrites the impact provided by the response plan.
    --
    -- __Possible impacts:__
    --
    -- -   @1@ - Critical impact, full application failure that impacts many to
    --     all customers.
    --
    -- -   @2@ - High impact, partial application failure with impact to many
    --     customers.
    --
    -- -   @3@ - Medium impact, the application is providing reduced service to
    --     customers.
    --
    -- -   @4@ - Low impact, customer aren\'t impacted by the problem yet.
    --
    -- -   @5@ - No impact, customers aren\'t currently impacted but urgent
    --     action is needed to avoid impact.
    UpdateIncidentRecord -> Maybe Natural
impact :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon SNS targets that are notified when updates are made to an
    -- incident.
    --
    -- Using multiple SNS topics creates redundancy in the event that a Region
    -- is down during the incident.
    UpdateIncidentRecord -> Maybe [NotificationTargetItem]
notificationTargets :: Prelude.Maybe [NotificationTargetItem],
    -- | The status of the incident. An incident can be @Open@ or @Resolved@.
    UpdateIncidentRecord -> Maybe IncidentRecordStatus
status :: Prelude.Maybe IncidentRecordStatus,
    -- | A longer description of what occurred during the incident.
    UpdateIncidentRecord -> Maybe Text
summary :: Prelude.Maybe Prelude.Text,
    -- | A brief description of the incident.
    UpdateIncidentRecord -> Maybe Text
title :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the incident record you are updating.
    UpdateIncidentRecord -> Text
arn :: Prelude.Text
  }
  deriving (UpdateIncidentRecord -> UpdateIncidentRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateIncidentRecord -> UpdateIncidentRecord -> Bool
$c/= :: UpdateIncidentRecord -> UpdateIncidentRecord -> Bool
== :: UpdateIncidentRecord -> UpdateIncidentRecord -> Bool
$c== :: UpdateIncidentRecord -> UpdateIncidentRecord -> Bool
Prelude.Eq, ReadPrec [UpdateIncidentRecord]
ReadPrec UpdateIncidentRecord
Int -> ReadS UpdateIncidentRecord
ReadS [UpdateIncidentRecord]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateIncidentRecord]
$creadListPrec :: ReadPrec [UpdateIncidentRecord]
readPrec :: ReadPrec UpdateIncidentRecord
$creadPrec :: ReadPrec UpdateIncidentRecord
readList :: ReadS [UpdateIncidentRecord]
$creadList :: ReadS [UpdateIncidentRecord]
readsPrec :: Int -> ReadS UpdateIncidentRecord
$creadsPrec :: Int -> ReadS UpdateIncidentRecord
Prelude.Read, Int -> UpdateIncidentRecord -> ShowS
[UpdateIncidentRecord] -> ShowS
UpdateIncidentRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateIncidentRecord] -> ShowS
$cshowList :: [UpdateIncidentRecord] -> ShowS
show :: UpdateIncidentRecord -> String
$cshow :: UpdateIncidentRecord -> String
showsPrec :: Int -> UpdateIncidentRecord -> ShowS
$cshowsPrec :: Int -> UpdateIncidentRecord -> ShowS
Prelude.Show, forall x. Rep UpdateIncidentRecord x -> UpdateIncidentRecord
forall x. UpdateIncidentRecord -> Rep UpdateIncidentRecord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateIncidentRecord x -> UpdateIncidentRecord
$cfrom :: forall x. UpdateIncidentRecord -> Rep UpdateIncidentRecord x
Prelude.Generic)

-- |
-- Create a value of 'UpdateIncidentRecord' 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:
--
-- 'chatChannel', 'updateIncidentRecord_chatChannel' - The Chatbot chat channel where responders can collaborate.
--
-- 'clientToken', 'updateIncidentRecord_clientToken' - A token that ensures that the operation is called only once with the
-- specified details.
--
-- 'impact', 'updateIncidentRecord_impact' - Defines the impact of the incident to customers and applications.
-- Providing an impact overwrites the impact provided by the response plan.
--
-- __Possible impacts:__
--
-- -   @1@ - Critical impact, full application failure that impacts many to
--     all customers.
--
-- -   @2@ - High impact, partial application failure with impact to many
--     customers.
--
-- -   @3@ - Medium impact, the application is providing reduced service to
--     customers.
--
-- -   @4@ - Low impact, customer aren\'t impacted by the problem yet.
--
-- -   @5@ - No impact, customers aren\'t currently impacted but urgent
--     action is needed to avoid impact.
--
-- 'notificationTargets', 'updateIncidentRecord_notificationTargets' - The Amazon SNS targets that are notified when updates are made to an
-- incident.
--
-- Using multiple SNS topics creates redundancy in the event that a Region
-- is down during the incident.
--
-- 'status', 'updateIncidentRecord_status' - The status of the incident. An incident can be @Open@ or @Resolved@.
--
-- 'summary', 'updateIncidentRecord_summary' - A longer description of what occurred during the incident.
--
-- 'title', 'updateIncidentRecord_title' - A brief description of the incident.
--
-- 'arn', 'updateIncidentRecord_arn' - The Amazon Resource Name (ARN) of the incident record you are updating.
newUpdateIncidentRecord ::
  -- | 'arn'
  Prelude.Text ->
  UpdateIncidentRecord
newUpdateIncidentRecord :: Text -> UpdateIncidentRecord
newUpdateIncidentRecord Text
pArn_ =
  UpdateIncidentRecord'
    { $sel:chatChannel:UpdateIncidentRecord' :: Maybe ChatChannel
chatChannel =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:UpdateIncidentRecord' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:impact:UpdateIncidentRecord' :: Maybe Natural
impact = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationTargets:UpdateIncidentRecord' :: Maybe [NotificationTargetItem]
notificationTargets = forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdateIncidentRecord' :: Maybe IncidentRecordStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:summary:UpdateIncidentRecord' :: Maybe Text
summary = forall a. Maybe a
Prelude.Nothing,
      $sel:title:UpdateIncidentRecord' :: Maybe Text
title = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:UpdateIncidentRecord' :: Text
arn = Text
pArn_
    }

-- | The Chatbot chat channel where responders can collaborate.
updateIncidentRecord_chatChannel :: Lens.Lens' UpdateIncidentRecord (Prelude.Maybe ChatChannel)
updateIncidentRecord_chatChannel :: Lens' UpdateIncidentRecord (Maybe ChatChannel)
updateIncidentRecord_chatChannel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIncidentRecord' {Maybe ChatChannel
chatChannel :: Maybe ChatChannel
$sel:chatChannel:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe ChatChannel
chatChannel} -> Maybe ChatChannel
chatChannel) (\s :: UpdateIncidentRecord
s@UpdateIncidentRecord' {} Maybe ChatChannel
a -> UpdateIncidentRecord
s {$sel:chatChannel:UpdateIncidentRecord' :: Maybe ChatChannel
chatChannel = Maybe ChatChannel
a} :: UpdateIncidentRecord)

-- | A token that ensures that the operation is called only once with the
-- specified details.
updateIncidentRecord_clientToken :: Lens.Lens' UpdateIncidentRecord (Prelude.Maybe Prelude.Text)
updateIncidentRecord_clientToken :: Lens' UpdateIncidentRecord (Maybe Text)
updateIncidentRecord_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIncidentRecord' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: UpdateIncidentRecord
s@UpdateIncidentRecord' {} Maybe Text
a -> UpdateIncidentRecord
s {$sel:clientToken:UpdateIncidentRecord' :: Maybe Text
clientToken = Maybe Text
a} :: UpdateIncidentRecord)

-- | Defines the impact of the incident to customers and applications.
-- Providing an impact overwrites the impact provided by the response plan.
--
-- __Possible impacts:__
--
-- -   @1@ - Critical impact, full application failure that impacts many to
--     all customers.
--
-- -   @2@ - High impact, partial application failure with impact to many
--     customers.
--
-- -   @3@ - Medium impact, the application is providing reduced service to
--     customers.
--
-- -   @4@ - Low impact, customer aren\'t impacted by the problem yet.
--
-- -   @5@ - No impact, customers aren\'t currently impacted but urgent
--     action is needed to avoid impact.
updateIncidentRecord_impact :: Lens.Lens' UpdateIncidentRecord (Prelude.Maybe Prelude.Natural)
updateIncidentRecord_impact :: Lens' UpdateIncidentRecord (Maybe Natural)
updateIncidentRecord_impact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIncidentRecord' {Maybe Natural
impact :: Maybe Natural
$sel:impact:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Natural
impact} -> Maybe Natural
impact) (\s :: UpdateIncidentRecord
s@UpdateIncidentRecord' {} Maybe Natural
a -> UpdateIncidentRecord
s {$sel:impact:UpdateIncidentRecord' :: Maybe Natural
impact = Maybe Natural
a} :: UpdateIncidentRecord)

-- | The Amazon SNS targets that are notified when updates are made to an
-- incident.
--
-- Using multiple SNS topics creates redundancy in the event that a Region
-- is down during the incident.
updateIncidentRecord_notificationTargets :: Lens.Lens' UpdateIncidentRecord (Prelude.Maybe [NotificationTargetItem])
updateIncidentRecord_notificationTargets :: Lens' UpdateIncidentRecord (Maybe [NotificationTargetItem])
updateIncidentRecord_notificationTargets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIncidentRecord' {Maybe [NotificationTargetItem]
notificationTargets :: Maybe [NotificationTargetItem]
$sel:notificationTargets:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe [NotificationTargetItem]
notificationTargets} -> Maybe [NotificationTargetItem]
notificationTargets) (\s :: UpdateIncidentRecord
s@UpdateIncidentRecord' {} Maybe [NotificationTargetItem]
a -> UpdateIncidentRecord
s {$sel:notificationTargets:UpdateIncidentRecord' :: Maybe [NotificationTargetItem]
notificationTargets = Maybe [NotificationTargetItem]
a} :: UpdateIncidentRecord) 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 status of the incident. An incident can be @Open@ or @Resolved@.
updateIncidentRecord_status :: Lens.Lens' UpdateIncidentRecord (Prelude.Maybe IncidentRecordStatus)
updateIncidentRecord_status :: Lens' UpdateIncidentRecord (Maybe IncidentRecordStatus)
updateIncidentRecord_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIncidentRecord' {Maybe IncidentRecordStatus
status :: Maybe IncidentRecordStatus
$sel:status:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe IncidentRecordStatus
status} -> Maybe IncidentRecordStatus
status) (\s :: UpdateIncidentRecord
s@UpdateIncidentRecord' {} Maybe IncidentRecordStatus
a -> UpdateIncidentRecord
s {$sel:status:UpdateIncidentRecord' :: Maybe IncidentRecordStatus
status = Maybe IncidentRecordStatus
a} :: UpdateIncidentRecord)

-- | A longer description of what occurred during the incident.
updateIncidentRecord_summary :: Lens.Lens' UpdateIncidentRecord (Prelude.Maybe Prelude.Text)
updateIncidentRecord_summary :: Lens' UpdateIncidentRecord (Maybe Text)
updateIncidentRecord_summary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIncidentRecord' {Maybe Text
summary :: Maybe Text
$sel:summary:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
summary} -> Maybe Text
summary) (\s :: UpdateIncidentRecord
s@UpdateIncidentRecord' {} Maybe Text
a -> UpdateIncidentRecord
s {$sel:summary:UpdateIncidentRecord' :: Maybe Text
summary = Maybe Text
a} :: UpdateIncidentRecord)

-- | A brief description of the incident.
updateIncidentRecord_title :: Lens.Lens' UpdateIncidentRecord (Prelude.Maybe Prelude.Text)
updateIncidentRecord_title :: Lens' UpdateIncidentRecord (Maybe Text)
updateIncidentRecord_title = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIncidentRecord' {Maybe Text
title :: Maybe Text
$sel:title:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
title} -> Maybe Text
title) (\s :: UpdateIncidentRecord
s@UpdateIncidentRecord' {} Maybe Text
a -> UpdateIncidentRecord
s {$sel:title:UpdateIncidentRecord' :: Maybe Text
title = Maybe Text
a} :: UpdateIncidentRecord)

-- | The Amazon Resource Name (ARN) of the incident record you are updating.
updateIncidentRecord_arn :: Lens.Lens' UpdateIncidentRecord Prelude.Text
updateIncidentRecord_arn :: Lens' UpdateIncidentRecord Text
updateIncidentRecord_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIncidentRecord' {Text
arn :: Text
$sel:arn:UpdateIncidentRecord' :: UpdateIncidentRecord -> Text
arn} -> Text
arn) (\s :: UpdateIncidentRecord
s@UpdateIncidentRecord' {} Text
a -> UpdateIncidentRecord
s {$sel:arn:UpdateIncidentRecord' :: Text
arn = Text
a} :: UpdateIncidentRecord)

instance Core.AWSRequest UpdateIncidentRecord where
  type
    AWSResponse UpdateIncidentRecord =
      UpdateIncidentRecordResponse
  request :: (Service -> Service)
-> UpdateIncidentRecord -> Request UpdateIncidentRecord
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 UpdateIncidentRecord
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateIncidentRecord)))
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 -> UpdateIncidentRecordResponse
UpdateIncidentRecordResponse'
            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 UpdateIncidentRecord where
  hashWithSalt :: Int -> UpdateIncidentRecord -> Int
hashWithSalt Int
_salt UpdateIncidentRecord' {Maybe Natural
Maybe [NotificationTargetItem]
Maybe Text
Maybe ChatChannel
Maybe IncidentRecordStatus
Text
arn :: Text
title :: Maybe Text
summary :: Maybe Text
status :: Maybe IncidentRecordStatus
notificationTargets :: Maybe [NotificationTargetItem]
impact :: Maybe Natural
clientToken :: Maybe Text
chatChannel :: Maybe ChatChannel
$sel:arn:UpdateIncidentRecord' :: UpdateIncidentRecord -> Text
$sel:title:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
$sel:summary:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
$sel:status:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe IncidentRecordStatus
$sel:notificationTargets:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe [NotificationTargetItem]
$sel:impact:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Natural
$sel:clientToken:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
$sel:chatChannel:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe ChatChannel
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChatChannel
chatChannel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
impact
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [NotificationTargetItem]
notificationTargets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IncidentRecordStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
summary
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
title
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

instance Prelude.NFData UpdateIncidentRecord where
  rnf :: UpdateIncidentRecord -> ()
rnf UpdateIncidentRecord' {Maybe Natural
Maybe [NotificationTargetItem]
Maybe Text
Maybe ChatChannel
Maybe IncidentRecordStatus
Text
arn :: Text
title :: Maybe Text
summary :: Maybe Text
status :: Maybe IncidentRecordStatus
notificationTargets :: Maybe [NotificationTargetItem]
impact :: Maybe Natural
clientToken :: Maybe Text
chatChannel :: Maybe ChatChannel
$sel:arn:UpdateIncidentRecord' :: UpdateIncidentRecord -> Text
$sel:title:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
$sel:summary:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
$sel:status:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe IncidentRecordStatus
$sel:notificationTargets:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe [NotificationTargetItem]
$sel:impact:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Natural
$sel:clientToken:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
$sel:chatChannel:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe ChatChannel
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ChatChannel
chatChannel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
impact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [NotificationTargetItem]
notificationTargets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IncidentRecordStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
summary
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
title
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn

instance Data.ToHeaders UpdateIncidentRecord where
  toHeaders :: UpdateIncidentRecord -> 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 UpdateIncidentRecord where
  toJSON :: UpdateIncidentRecord -> Value
toJSON UpdateIncidentRecord' {Maybe Natural
Maybe [NotificationTargetItem]
Maybe Text
Maybe ChatChannel
Maybe IncidentRecordStatus
Text
arn :: Text
title :: Maybe Text
summary :: Maybe Text
status :: Maybe IncidentRecordStatus
notificationTargets :: Maybe [NotificationTargetItem]
impact :: Maybe Natural
clientToken :: Maybe Text
chatChannel :: Maybe ChatChannel
$sel:arn:UpdateIncidentRecord' :: UpdateIncidentRecord -> Text
$sel:title:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
$sel:summary:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
$sel:status:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe IncidentRecordStatus
$sel:notificationTargets:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe [NotificationTargetItem]
$sel:impact:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Natural
$sel:clientToken:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe Text
$sel:chatChannel:UpdateIncidentRecord' :: UpdateIncidentRecord -> Maybe ChatChannel
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"chatChannel" 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 ChatChannel
chatChannel,
            (Key
"clientToken" 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
clientToken,
            (Key
"impact" 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 Natural
impact,
            (Key
"notificationTargets" 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 [NotificationTargetItem]
notificationTargets,
            (Key
"status" 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 IncidentRecordStatus
status,
            (Key
"summary" 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
summary,
            (Key
"title" 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
title,
            forall a. a -> Maybe a
Prelude.Just (Key
"arn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
arn)
          ]
      )

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

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

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

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

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

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