{-# 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.IoT.CreateMitigationAction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Defines an action that can be applied to audit findings by using
-- StartAuditMitigationActionsTask. Only certain types of mitigation
-- actions can be applied to specific check names. For more information,
-- see
-- <https://docs.aws.amazon.com/iot/latest/developerguide/device-defender-mitigation-actions.html Mitigation actions>.
-- Each mitigation action can apply only one type of change.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions CreateMitigationAction>
-- action.
module Amazonka.IoT.CreateMitigationAction
  ( -- * Creating a Request
    CreateMitigationAction (..),
    newCreateMitigationAction,

    -- * Request Lenses
    createMitigationAction_tags,
    createMitigationAction_actionName,
    createMitigationAction_roleArn,
    createMitigationAction_actionParams,

    -- * Destructuring the Response
    CreateMitigationActionResponse (..),
    newCreateMitigationActionResponse,

    -- * Response Lenses
    createMitigationActionResponse_actionArn,
    createMitigationActionResponse_actionId,
    createMitigationActionResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoT.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateMitigationAction' smart constructor.
data CreateMitigationAction = CreateMitigationAction'
  { -- | Metadata that can be used to manage the mitigation action.
    CreateMitigationAction -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A friendly name for the action. Choose a friendly name that accurately
    -- describes the action (for example, @EnableLoggingAction@).
    CreateMitigationAction -> Text
actionName :: Prelude.Text,
    -- | The ARN of the IAM role that is used to apply the mitigation action.
    CreateMitigationAction -> Text
roleArn :: Prelude.Text,
    -- | Defines the type of action and the parameters for that action.
    CreateMitigationAction -> MitigationActionParams
actionParams :: MitigationActionParams
  }
  deriving (CreateMitigationAction -> CreateMitigationAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMitigationAction -> CreateMitigationAction -> Bool
$c/= :: CreateMitigationAction -> CreateMitigationAction -> Bool
== :: CreateMitigationAction -> CreateMitigationAction -> Bool
$c== :: CreateMitigationAction -> CreateMitigationAction -> Bool
Prelude.Eq, ReadPrec [CreateMitigationAction]
ReadPrec CreateMitigationAction
Int -> ReadS CreateMitigationAction
ReadS [CreateMitigationAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateMitigationAction]
$creadListPrec :: ReadPrec [CreateMitigationAction]
readPrec :: ReadPrec CreateMitigationAction
$creadPrec :: ReadPrec CreateMitigationAction
readList :: ReadS [CreateMitigationAction]
$creadList :: ReadS [CreateMitigationAction]
readsPrec :: Int -> ReadS CreateMitigationAction
$creadsPrec :: Int -> ReadS CreateMitigationAction
Prelude.Read, Int -> CreateMitigationAction -> ShowS
[CreateMitigationAction] -> ShowS
CreateMitigationAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMitigationAction] -> ShowS
$cshowList :: [CreateMitigationAction] -> ShowS
show :: CreateMitigationAction -> String
$cshow :: CreateMitigationAction -> String
showsPrec :: Int -> CreateMitigationAction -> ShowS
$cshowsPrec :: Int -> CreateMitigationAction -> ShowS
Prelude.Show, forall x. Rep CreateMitigationAction x -> CreateMitigationAction
forall x. CreateMitigationAction -> Rep CreateMitigationAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateMitigationAction x -> CreateMitigationAction
$cfrom :: forall x. CreateMitigationAction -> Rep CreateMitigationAction x
Prelude.Generic)

-- |
-- Create a value of 'CreateMitigationAction' 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:
--
-- 'tags', 'createMitigationAction_tags' - Metadata that can be used to manage the mitigation action.
--
-- 'actionName', 'createMitigationAction_actionName' - A friendly name for the action. Choose a friendly name that accurately
-- describes the action (for example, @EnableLoggingAction@).
--
-- 'roleArn', 'createMitigationAction_roleArn' - The ARN of the IAM role that is used to apply the mitigation action.
--
-- 'actionParams', 'createMitigationAction_actionParams' - Defines the type of action and the parameters for that action.
newCreateMitigationAction ::
  -- | 'actionName'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'actionParams'
  MitigationActionParams ->
  CreateMitigationAction
newCreateMitigationAction :: Text -> Text -> MitigationActionParams -> CreateMitigationAction
newCreateMitigationAction
  Text
pActionName_
  Text
pRoleArn_
  MitigationActionParams
pActionParams_ =
    CreateMitigationAction'
      { $sel:tags:CreateMitigationAction' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:actionName:CreateMitigationAction' :: Text
actionName = Text
pActionName_,
        $sel:roleArn:CreateMitigationAction' :: Text
roleArn = Text
pRoleArn_,
        $sel:actionParams:CreateMitigationAction' :: MitigationActionParams
actionParams = MitigationActionParams
pActionParams_
      }

-- | Metadata that can be used to manage the mitigation action.
createMitigationAction_tags :: Lens.Lens' CreateMitigationAction (Prelude.Maybe [Tag])
createMitigationAction_tags :: Lens' CreateMitigationAction (Maybe [Tag])
createMitigationAction_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMitigationAction' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateMitigationAction' :: CreateMitigationAction -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateMitigationAction
s@CreateMitigationAction' {} Maybe [Tag]
a -> CreateMitigationAction
s {$sel:tags:CreateMitigationAction' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateMitigationAction) 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

-- | A friendly name for the action. Choose a friendly name that accurately
-- describes the action (for example, @EnableLoggingAction@).
createMitigationAction_actionName :: Lens.Lens' CreateMitigationAction Prelude.Text
createMitigationAction_actionName :: Lens' CreateMitigationAction Text
createMitigationAction_actionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMitigationAction' {Text
actionName :: Text
$sel:actionName:CreateMitigationAction' :: CreateMitigationAction -> Text
actionName} -> Text
actionName) (\s :: CreateMitigationAction
s@CreateMitigationAction' {} Text
a -> CreateMitigationAction
s {$sel:actionName:CreateMitigationAction' :: Text
actionName = Text
a} :: CreateMitigationAction)

-- | The ARN of the IAM role that is used to apply the mitigation action.
createMitigationAction_roleArn :: Lens.Lens' CreateMitigationAction Prelude.Text
createMitigationAction_roleArn :: Lens' CreateMitigationAction Text
createMitigationAction_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMitigationAction' {Text
roleArn :: Text
$sel:roleArn:CreateMitigationAction' :: CreateMitigationAction -> Text
roleArn} -> Text
roleArn) (\s :: CreateMitigationAction
s@CreateMitigationAction' {} Text
a -> CreateMitigationAction
s {$sel:roleArn:CreateMitigationAction' :: Text
roleArn = Text
a} :: CreateMitigationAction)

-- | Defines the type of action and the parameters for that action.
createMitigationAction_actionParams :: Lens.Lens' CreateMitigationAction MitigationActionParams
createMitigationAction_actionParams :: Lens' CreateMitigationAction MitigationActionParams
createMitigationAction_actionParams = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMitigationAction' {MitigationActionParams
actionParams :: MitigationActionParams
$sel:actionParams:CreateMitigationAction' :: CreateMitigationAction -> MitigationActionParams
actionParams} -> MitigationActionParams
actionParams) (\s :: CreateMitigationAction
s@CreateMitigationAction' {} MitigationActionParams
a -> CreateMitigationAction
s {$sel:actionParams:CreateMitigationAction' :: MitigationActionParams
actionParams = MitigationActionParams
a} :: CreateMitigationAction)

instance Core.AWSRequest CreateMitigationAction where
  type
    AWSResponse CreateMitigationAction =
      CreateMitigationActionResponse
  request :: (Service -> Service)
-> CreateMitigationAction -> Request CreateMitigationAction
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 CreateMitigationAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateMitigationAction)))
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 ->
          Maybe Text -> Maybe Text -> Int -> CreateMitigationActionResponse
CreateMitigationActionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"actionArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"actionId")
            forall (f :: * -> *) a b. Applicative f => 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 CreateMitigationAction where
  hashWithSalt :: Int -> CreateMitigationAction -> Int
hashWithSalt Int
_salt CreateMitigationAction' {Maybe [Tag]
Text
MitigationActionParams
actionParams :: MitigationActionParams
roleArn :: Text
actionName :: Text
tags :: Maybe [Tag]
$sel:actionParams:CreateMitigationAction' :: CreateMitigationAction -> MitigationActionParams
$sel:roleArn:CreateMitigationAction' :: CreateMitigationAction -> Text
$sel:actionName:CreateMitigationAction' :: CreateMitigationAction -> Text
$sel:tags:CreateMitigationAction' :: CreateMitigationAction -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
actionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MitigationActionParams
actionParams

instance Prelude.NFData CreateMitigationAction where
  rnf :: CreateMitigationAction -> ()
rnf CreateMitigationAction' {Maybe [Tag]
Text
MitigationActionParams
actionParams :: MitigationActionParams
roleArn :: Text
actionName :: Text
tags :: Maybe [Tag]
$sel:actionParams:CreateMitigationAction' :: CreateMitigationAction -> MitigationActionParams
$sel:roleArn:CreateMitigationAction' :: CreateMitigationAction -> Text
$sel:actionName:CreateMitigationAction' :: CreateMitigationAction -> Text
$sel:tags:CreateMitigationAction' :: CreateMitigationAction -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
actionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MitigationActionParams
actionParams

instance Data.ToHeaders CreateMitigationAction where
  toHeaders :: CreateMitigationAction -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON CreateMitigationAction where
  toJSON :: CreateMitigationAction -> Value
toJSON CreateMitigationAction' {Maybe [Tag]
Text
MitigationActionParams
actionParams :: MitigationActionParams
roleArn :: Text
actionName :: Text
tags :: Maybe [Tag]
$sel:actionParams:CreateMitigationAction' :: CreateMitigationAction -> MitigationActionParams
$sel:roleArn:CreateMitigationAction' :: CreateMitigationAction -> Text
$sel:actionName:CreateMitigationAction' :: CreateMitigationAction -> Text
$sel:tags:CreateMitigationAction' :: CreateMitigationAction -> Maybe [Tag]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"roleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"actionParams" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MitigationActionParams
actionParams)
          ]
      )

instance Data.ToPath CreateMitigationAction where
  toPath :: CreateMitigationAction -> ByteString
toPath CreateMitigationAction' {Maybe [Tag]
Text
MitigationActionParams
actionParams :: MitigationActionParams
roleArn :: Text
actionName :: Text
tags :: Maybe [Tag]
$sel:actionParams:CreateMitigationAction' :: CreateMitigationAction -> MitigationActionParams
$sel:roleArn:CreateMitigationAction' :: CreateMitigationAction -> Text
$sel:actionName:CreateMitigationAction' :: CreateMitigationAction -> Text
$sel:tags:CreateMitigationAction' :: CreateMitigationAction -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/mitigationactions/actions/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
actionName]

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

-- | /See:/ 'newCreateMitigationActionResponse' smart constructor.
data CreateMitigationActionResponse = CreateMitigationActionResponse'
  { -- | The ARN for the new mitigation action.
    CreateMitigationActionResponse -> Maybe Text
actionArn :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the new mitigation action.
    CreateMitigationActionResponse -> Maybe Text
actionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateMitigationActionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateMitigationActionResponse
-> CreateMitigationActionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMitigationActionResponse
-> CreateMitigationActionResponse -> Bool
$c/= :: CreateMitigationActionResponse
-> CreateMitigationActionResponse -> Bool
== :: CreateMitigationActionResponse
-> CreateMitigationActionResponse -> Bool
$c== :: CreateMitigationActionResponse
-> CreateMitigationActionResponse -> Bool
Prelude.Eq, ReadPrec [CreateMitigationActionResponse]
ReadPrec CreateMitigationActionResponse
Int -> ReadS CreateMitigationActionResponse
ReadS [CreateMitigationActionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateMitigationActionResponse]
$creadListPrec :: ReadPrec [CreateMitigationActionResponse]
readPrec :: ReadPrec CreateMitigationActionResponse
$creadPrec :: ReadPrec CreateMitigationActionResponse
readList :: ReadS [CreateMitigationActionResponse]
$creadList :: ReadS [CreateMitigationActionResponse]
readsPrec :: Int -> ReadS CreateMitigationActionResponse
$creadsPrec :: Int -> ReadS CreateMitigationActionResponse
Prelude.Read, Int -> CreateMitigationActionResponse -> ShowS
[CreateMitigationActionResponse] -> ShowS
CreateMitigationActionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMitigationActionResponse] -> ShowS
$cshowList :: [CreateMitigationActionResponse] -> ShowS
show :: CreateMitigationActionResponse -> String
$cshow :: CreateMitigationActionResponse -> String
showsPrec :: Int -> CreateMitigationActionResponse -> ShowS
$cshowsPrec :: Int -> CreateMitigationActionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateMitigationActionResponse x
-> CreateMitigationActionResponse
forall x.
CreateMitigationActionResponse
-> Rep CreateMitigationActionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateMitigationActionResponse x
-> CreateMitigationActionResponse
$cfrom :: forall x.
CreateMitigationActionResponse
-> Rep CreateMitigationActionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateMitigationActionResponse' 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:
--
-- 'actionArn', 'createMitigationActionResponse_actionArn' - The ARN for the new mitigation action.
--
-- 'actionId', 'createMitigationActionResponse_actionId' - A unique identifier for the new mitigation action.
--
-- 'httpStatus', 'createMitigationActionResponse_httpStatus' - The response's http status code.
newCreateMitigationActionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateMitigationActionResponse
newCreateMitigationActionResponse :: Int -> CreateMitigationActionResponse
newCreateMitigationActionResponse Int
pHttpStatus_ =
  CreateMitigationActionResponse'
    { $sel:actionArn:CreateMitigationActionResponse' :: Maybe Text
actionArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:actionId:CreateMitigationActionResponse' :: Maybe Text
actionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateMitigationActionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN for the new mitigation action.
createMitigationActionResponse_actionArn :: Lens.Lens' CreateMitigationActionResponse (Prelude.Maybe Prelude.Text)
createMitigationActionResponse_actionArn :: Lens' CreateMitigationActionResponse (Maybe Text)
createMitigationActionResponse_actionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMitigationActionResponse' {Maybe Text
actionArn :: Maybe Text
$sel:actionArn:CreateMitigationActionResponse' :: CreateMitigationActionResponse -> Maybe Text
actionArn} -> Maybe Text
actionArn) (\s :: CreateMitigationActionResponse
s@CreateMitigationActionResponse' {} Maybe Text
a -> CreateMitigationActionResponse
s {$sel:actionArn:CreateMitigationActionResponse' :: Maybe Text
actionArn = Maybe Text
a} :: CreateMitigationActionResponse)

-- | A unique identifier for the new mitigation action.
createMitigationActionResponse_actionId :: Lens.Lens' CreateMitigationActionResponse (Prelude.Maybe Prelude.Text)
createMitigationActionResponse_actionId :: Lens' CreateMitigationActionResponse (Maybe Text)
createMitigationActionResponse_actionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMitigationActionResponse' {Maybe Text
actionId :: Maybe Text
$sel:actionId:CreateMitigationActionResponse' :: CreateMitigationActionResponse -> Maybe Text
actionId} -> Maybe Text
actionId) (\s :: CreateMitigationActionResponse
s@CreateMitigationActionResponse' {} Maybe Text
a -> CreateMitigationActionResponse
s {$sel:actionId:CreateMitigationActionResponse' :: Maybe Text
actionId = Maybe Text
a} :: CreateMitigationActionResponse)

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

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