{-# 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.StartIncident
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Used to start an incident from CloudWatch alarms, EventBridge events, or
-- manually.
module Amazonka.SSMIncidents.StartIncident
  ( -- * Creating a Request
    StartIncident (..),
    newStartIncident,

    -- * Request Lenses
    startIncident_clientToken,
    startIncident_impact,
    startIncident_relatedItems,
    startIncident_title,
    startIncident_triggerDetails,
    startIncident_responsePlanArn,

    -- * Destructuring the Response
    StartIncidentResponse (..),
    newStartIncidentResponse,

    -- * Response Lenses
    startIncidentResponse_httpStatus,
    startIncidentResponse_incidentRecordArn,
  )
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:/ 'newStartIncident' smart constructor.
data StartIncident = StartIncident'
  { -- | A token ensuring that the operation is called only once with the
    -- specified details.
    StartIncident -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Defines the impact to the customers. Providing an impact overwrites the
    -- impact provided by a response plan.
    --
    -- __Possible impacts:__
    --
    -- -   @1@ - Critical impact, this typically relates to 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 might aren\'t impacted by the problem
    --     yet.
    --
    -- -   @5@ - No impact, customers aren\'t currently impacted but urgent
    --     action is needed to avoid impact.
    StartIncident -> Maybe Natural
impact :: Prelude.Maybe Prelude.Natural,
    -- | Add related items to the incident for other responders to use. Related
    -- items are AWS resources, external links, or files uploaded to an Amazon
    -- S3 bucket.
    StartIncident -> Maybe [RelatedItem]
relatedItems :: Prelude.Maybe [RelatedItem],
    -- | Provide a title for the incident. Providing a title overwrites the title
    -- provided by the response plan.
    StartIncident -> Maybe Text
title :: Prelude.Maybe Prelude.Text,
    -- | Details of what created the incident record in Incident Manager.
    StartIncident -> Maybe TriggerDetails
triggerDetails :: Prelude.Maybe TriggerDetails,
    -- | The Amazon Resource Name (ARN) of the response plan that pre-defines
    -- summary, chat channels, Amazon SNS topics, runbooks, title, and impact
    -- of the incident.
    StartIncident -> Text
responsePlanArn :: Prelude.Text
  }
  deriving (StartIncident -> StartIncident -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartIncident -> StartIncident -> Bool
$c/= :: StartIncident -> StartIncident -> Bool
== :: StartIncident -> StartIncident -> Bool
$c== :: StartIncident -> StartIncident -> Bool
Prelude.Eq, ReadPrec [StartIncident]
ReadPrec StartIncident
Int -> ReadS StartIncident
ReadS [StartIncident]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartIncident]
$creadListPrec :: ReadPrec [StartIncident]
readPrec :: ReadPrec StartIncident
$creadPrec :: ReadPrec StartIncident
readList :: ReadS [StartIncident]
$creadList :: ReadS [StartIncident]
readsPrec :: Int -> ReadS StartIncident
$creadsPrec :: Int -> ReadS StartIncident
Prelude.Read, Int -> StartIncident -> ShowS
[StartIncident] -> ShowS
StartIncident -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartIncident] -> ShowS
$cshowList :: [StartIncident] -> ShowS
show :: StartIncident -> String
$cshow :: StartIncident -> String
showsPrec :: Int -> StartIncident -> ShowS
$cshowsPrec :: Int -> StartIncident -> ShowS
Prelude.Show, forall x. Rep StartIncident x -> StartIncident
forall x. StartIncident -> Rep StartIncident x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartIncident x -> StartIncident
$cfrom :: forall x. StartIncident -> Rep StartIncident x
Prelude.Generic)

-- |
-- Create a value of 'StartIncident' 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:
--
-- 'clientToken', 'startIncident_clientToken' - A token ensuring that the operation is called only once with the
-- specified details.
--
-- 'impact', 'startIncident_impact' - Defines the impact to the customers. Providing an impact overwrites the
-- impact provided by a response plan.
--
-- __Possible impacts:__
--
-- -   @1@ - Critical impact, this typically relates to 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 might aren\'t impacted by the problem
--     yet.
--
-- -   @5@ - No impact, customers aren\'t currently impacted but urgent
--     action is needed to avoid impact.
--
-- 'relatedItems', 'startIncident_relatedItems' - Add related items to the incident for other responders to use. Related
-- items are AWS resources, external links, or files uploaded to an Amazon
-- S3 bucket.
--
-- 'title', 'startIncident_title' - Provide a title for the incident. Providing a title overwrites the title
-- provided by the response plan.
--
-- 'triggerDetails', 'startIncident_triggerDetails' - Details of what created the incident record in Incident Manager.
--
-- 'responsePlanArn', 'startIncident_responsePlanArn' - The Amazon Resource Name (ARN) of the response plan that pre-defines
-- summary, chat channels, Amazon SNS topics, runbooks, title, and impact
-- of the incident.
newStartIncident ::
  -- | 'responsePlanArn'
  Prelude.Text ->
  StartIncident
newStartIncident :: Text -> StartIncident
newStartIncident Text
pResponsePlanArn_ =
  StartIncident'
    { $sel:clientToken:StartIncident' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:impact:StartIncident' :: Maybe Natural
impact = forall a. Maybe a
Prelude.Nothing,
      $sel:relatedItems:StartIncident' :: Maybe [RelatedItem]
relatedItems = forall a. Maybe a
Prelude.Nothing,
      $sel:title:StartIncident' :: Maybe Text
title = forall a. Maybe a
Prelude.Nothing,
      $sel:triggerDetails:StartIncident' :: Maybe TriggerDetails
triggerDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:responsePlanArn:StartIncident' :: Text
responsePlanArn = Text
pResponsePlanArn_
    }

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

-- | Defines the impact to the customers. Providing an impact overwrites the
-- impact provided by a response plan.
--
-- __Possible impacts:__
--
-- -   @1@ - Critical impact, this typically relates to 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 might aren\'t impacted by the problem
--     yet.
--
-- -   @5@ - No impact, customers aren\'t currently impacted but urgent
--     action is needed to avoid impact.
startIncident_impact :: Lens.Lens' StartIncident (Prelude.Maybe Prelude.Natural)
startIncident_impact :: Lens' StartIncident (Maybe Natural)
startIncident_impact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartIncident' {Maybe Natural
impact :: Maybe Natural
$sel:impact:StartIncident' :: StartIncident -> Maybe Natural
impact} -> Maybe Natural
impact) (\s :: StartIncident
s@StartIncident' {} Maybe Natural
a -> StartIncident
s {$sel:impact:StartIncident' :: Maybe Natural
impact = Maybe Natural
a} :: StartIncident)

-- | Add related items to the incident for other responders to use. Related
-- items are AWS resources, external links, or files uploaded to an Amazon
-- S3 bucket.
startIncident_relatedItems :: Lens.Lens' StartIncident (Prelude.Maybe [RelatedItem])
startIncident_relatedItems :: Lens' StartIncident (Maybe [RelatedItem])
startIncident_relatedItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartIncident' {Maybe [RelatedItem]
relatedItems :: Maybe [RelatedItem]
$sel:relatedItems:StartIncident' :: StartIncident -> Maybe [RelatedItem]
relatedItems} -> Maybe [RelatedItem]
relatedItems) (\s :: StartIncident
s@StartIncident' {} Maybe [RelatedItem]
a -> StartIncident
s {$sel:relatedItems:StartIncident' :: Maybe [RelatedItem]
relatedItems = Maybe [RelatedItem]
a} :: StartIncident) 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

-- | Provide a title for the incident. Providing a title overwrites the title
-- provided by the response plan.
startIncident_title :: Lens.Lens' StartIncident (Prelude.Maybe Prelude.Text)
startIncident_title :: Lens' StartIncident (Maybe Text)
startIncident_title = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartIncident' {Maybe Text
title :: Maybe Text
$sel:title:StartIncident' :: StartIncident -> Maybe Text
title} -> Maybe Text
title) (\s :: StartIncident
s@StartIncident' {} Maybe Text
a -> StartIncident
s {$sel:title:StartIncident' :: Maybe Text
title = Maybe Text
a} :: StartIncident)

-- | Details of what created the incident record in Incident Manager.
startIncident_triggerDetails :: Lens.Lens' StartIncident (Prelude.Maybe TriggerDetails)
startIncident_triggerDetails :: Lens' StartIncident (Maybe TriggerDetails)
startIncident_triggerDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartIncident' {Maybe TriggerDetails
triggerDetails :: Maybe TriggerDetails
$sel:triggerDetails:StartIncident' :: StartIncident -> Maybe TriggerDetails
triggerDetails} -> Maybe TriggerDetails
triggerDetails) (\s :: StartIncident
s@StartIncident' {} Maybe TriggerDetails
a -> StartIncident
s {$sel:triggerDetails:StartIncident' :: Maybe TriggerDetails
triggerDetails = Maybe TriggerDetails
a} :: StartIncident)

-- | The Amazon Resource Name (ARN) of the response plan that pre-defines
-- summary, chat channels, Amazon SNS topics, runbooks, title, and impact
-- of the incident.
startIncident_responsePlanArn :: Lens.Lens' StartIncident Prelude.Text
startIncident_responsePlanArn :: Lens' StartIncident Text
startIncident_responsePlanArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartIncident' {Text
responsePlanArn :: Text
$sel:responsePlanArn:StartIncident' :: StartIncident -> Text
responsePlanArn} -> Text
responsePlanArn) (\s :: StartIncident
s@StartIncident' {} Text
a -> StartIncident
s {$sel:responsePlanArn:StartIncident' :: Text
responsePlanArn = Text
a} :: StartIncident)

instance Core.AWSRequest StartIncident where
  type
    AWSResponse StartIncident =
      StartIncidentResponse
  request :: (Service -> Service) -> StartIncident -> Request StartIncident
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 StartIncident
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartIncident)))
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 ->
          Int -> Text -> StartIncidentResponse
StartIncidentResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"incidentRecordArn")
      )

instance Prelude.Hashable StartIncident where
  hashWithSalt :: Int -> StartIncident -> Int
hashWithSalt Int
_salt StartIncident' {Maybe Natural
Maybe [RelatedItem]
Maybe Text
Maybe TriggerDetails
Text
responsePlanArn :: Text
triggerDetails :: Maybe TriggerDetails
title :: Maybe Text
relatedItems :: Maybe [RelatedItem]
impact :: Maybe Natural
clientToken :: Maybe Text
$sel:responsePlanArn:StartIncident' :: StartIncident -> Text
$sel:triggerDetails:StartIncident' :: StartIncident -> Maybe TriggerDetails
$sel:title:StartIncident' :: StartIncident -> Maybe Text
$sel:relatedItems:StartIncident' :: StartIncident -> Maybe [RelatedItem]
$sel:impact:StartIncident' :: StartIncident -> Maybe Natural
$sel:clientToken:StartIncident' :: StartIncident -> Maybe Text
..} =
    Int
_salt
      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 [RelatedItem]
relatedItems
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
title
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TriggerDetails
triggerDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
responsePlanArn

instance Prelude.NFData StartIncident where
  rnf :: StartIncident -> ()
rnf StartIncident' {Maybe Natural
Maybe [RelatedItem]
Maybe Text
Maybe TriggerDetails
Text
responsePlanArn :: Text
triggerDetails :: Maybe TriggerDetails
title :: Maybe Text
relatedItems :: Maybe [RelatedItem]
impact :: Maybe Natural
clientToken :: Maybe Text
$sel:responsePlanArn:StartIncident' :: StartIncident -> Text
$sel:triggerDetails:StartIncident' :: StartIncident -> Maybe TriggerDetails
$sel:title:StartIncident' :: StartIncident -> Maybe Text
$sel:relatedItems:StartIncident' :: StartIncident -> Maybe [RelatedItem]
$sel:impact:StartIncident' :: StartIncident -> Maybe Natural
$sel:clientToken:StartIncident' :: StartIncident -> Maybe Text
..} =
    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 [RelatedItem]
relatedItems
      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 Maybe TriggerDetails
triggerDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
responsePlanArn

instance Data.ToHeaders StartIncident where
  toHeaders :: StartIncident -> 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 StartIncident where
  toJSON :: StartIncident -> Value
toJSON StartIncident' {Maybe Natural
Maybe [RelatedItem]
Maybe Text
Maybe TriggerDetails
Text
responsePlanArn :: Text
triggerDetails :: Maybe TriggerDetails
title :: Maybe Text
relatedItems :: Maybe [RelatedItem]
impact :: Maybe Natural
clientToken :: Maybe Text
$sel:responsePlanArn:StartIncident' :: StartIncident -> Text
$sel:triggerDetails:StartIncident' :: StartIncident -> Maybe TriggerDetails
$sel:title:StartIncident' :: StartIncident -> Maybe Text
$sel:relatedItems:StartIncident' :: StartIncident -> Maybe [RelatedItem]
$sel:impact:StartIncident' :: StartIncident -> Maybe Natural
$sel:clientToken:StartIncident' :: StartIncident -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"relatedItems" 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 [RelatedItem]
relatedItems,
            (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,
            (Key
"triggerDetails" 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 TriggerDetails
triggerDetails,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"responsePlanArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
responsePlanArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'StartIncidentResponse' 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', 'startIncidentResponse_httpStatus' - The response's http status code.
--
-- 'incidentRecordArn', 'startIncidentResponse_incidentRecordArn' - The ARN of the newly created incident record.
newStartIncidentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'incidentRecordArn'
  Prelude.Text ->
  StartIncidentResponse
newStartIncidentResponse :: Int -> Text -> StartIncidentResponse
newStartIncidentResponse
  Int
pHttpStatus_
  Text
pIncidentRecordArn_ =
    StartIncidentResponse'
      { $sel:httpStatus:StartIncidentResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:incidentRecordArn:StartIncidentResponse' :: Text
incidentRecordArn = Text
pIncidentRecordArn_
      }

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

-- | The ARN of the newly created incident record.
startIncidentResponse_incidentRecordArn :: Lens.Lens' StartIncidentResponse Prelude.Text
startIncidentResponse_incidentRecordArn :: Lens' StartIncidentResponse Text
startIncidentResponse_incidentRecordArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartIncidentResponse' {Text
incidentRecordArn :: Text
$sel:incidentRecordArn:StartIncidentResponse' :: StartIncidentResponse -> Text
incidentRecordArn} -> Text
incidentRecordArn) (\s :: StartIncidentResponse
s@StartIncidentResponse' {} Text
a -> StartIncidentResponse
s {$sel:incidentRecordArn:StartIncidentResponse' :: Text
incidentRecordArn = Text
a} :: StartIncidentResponse)

instance Prelude.NFData StartIncidentResponse where
  rnf :: StartIncidentResponse -> ()
rnf StartIncidentResponse' {Int
Text
incidentRecordArn :: Text
httpStatus :: Int
$sel:incidentRecordArn:StartIncidentResponse' :: StartIncidentResponse -> Text
$sel:httpStatus:StartIncidentResponse' :: StartIncidentResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
incidentRecordArn