{-# 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.AuditManager.CreateControl
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new custom control in Audit Manager.
module Amazonka.AuditManager.CreateControl
  ( -- * Creating a Request
    CreateControl (..),
    newCreateControl,

    -- * Request Lenses
    createControl_actionPlanInstructions,
    createControl_actionPlanTitle,
    createControl_description,
    createControl_tags,
    createControl_testingInformation,
    createControl_name,
    createControl_controlMappingSources,

    -- * Destructuring the Response
    CreateControlResponse (..),
    newCreateControlResponse,

    -- * Response Lenses
    createControlResponse_control,
    createControlResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateControl' smart constructor.
data CreateControl = CreateControl'
  { -- | The recommended actions to carry out if the control isn\'t fulfilled.
    CreateControl -> Maybe Text
actionPlanInstructions :: Prelude.Maybe Prelude.Text,
    -- | The title of the action plan for remediating the control.
    CreateControl -> Maybe Text
actionPlanTitle :: Prelude.Maybe Prelude.Text,
    -- | The description of the control.
    CreateControl -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The tags that are associated with the control.
    CreateControl -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The steps to follow to determine if the control is satisfied.
    CreateControl -> Maybe Text
testingInformation :: Prelude.Maybe Prelude.Text,
    -- | The name of the control.
    CreateControl -> Text
name :: Prelude.Text,
    -- | The data mapping sources for the control.
    CreateControl -> NonEmpty CreateControlMappingSource
controlMappingSources :: Prelude.NonEmpty CreateControlMappingSource
  }
  deriving (CreateControl -> CreateControl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateControl -> CreateControl -> Bool
$c/= :: CreateControl -> CreateControl -> Bool
== :: CreateControl -> CreateControl -> Bool
$c== :: CreateControl -> CreateControl -> Bool
Prelude.Eq, ReadPrec [CreateControl]
ReadPrec CreateControl
Int -> ReadS CreateControl
ReadS [CreateControl]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateControl]
$creadListPrec :: ReadPrec [CreateControl]
readPrec :: ReadPrec CreateControl
$creadPrec :: ReadPrec CreateControl
readList :: ReadS [CreateControl]
$creadList :: ReadS [CreateControl]
readsPrec :: Int -> ReadS CreateControl
$creadsPrec :: Int -> ReadS CreateControl
Prelude.Read, Int -> CreateControl -> ShowS
[CreateControl] -> ShowS
CreateControl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateControl] -> ShowS
$cshowList :: [CreateControl] -> ShowS
show :: CreateControl -> String
$cshow :: CreateControl -> String
showsPrec :: Int -> CreateControl -> ShowS
$cshowsPrec :: Int -> CreateControl -> ShowS
Prelude.Show, forall x. Rep CreateControl x -> CreateControl
forall x. CreateControl -> Rep CreateControl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateControl x -> CreateControl
$cfrom :: forall x. CreateControl -> Rep CreateControl x
Prelude.Generic)

-- |
-- Create a value of 'CreateControl' 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:
--
-- 'actionPlanInstructions', 'createControl_actionPlanInstructions' - The recommended actions to carry out if the control isn\'t fulfilled.
--
-- 'actionPlanTitle', 'createControl_actionPlanTitle' - The title of the action plan for remediating the control.
--
-- 'description', 'createControl_description' - The description of the control.
--
-- 'tags', 'createControl_tags' - The tags that are associated with the control.
--
-- 'testingInformation', 'createControl_testingInformation' - The steps to follow to determine if the control is satisfied.
--
-- 'name', 'createControl_name' - The name of the control.
--
-- 'controlMappingSources', 'createControl_controlMappingSources' - The data mapping sources for the control.
newCreateControl ::
  -- | 'name'
  Prelude.Text ->
  -- | 'controlMappingSources'
  Prelude.NonEmpty CreateControlMappingSource ->
  CreateControl
newCreateControl :: Text -> NonEmpty CreateControlMappingSource -> CreateControl
newCreateControl Text
pName_ NonEmpty CreateControlMappingSource
pControlMappingSources_ =
  CreateControl'
    { $sel:actionPlanInstructions:CreateControl' :: Maybe Text
actionPlanInstructions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:actionPlanTitle:CreateControl' :: Maybe Text
actionPlanTitle = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateControl' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateControl' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:testingInformation:CreateControl' :: Maybe Text
testingInformation = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateControl' :: Text
name = Text
pName_,
      $sel:controlMappingSources:CreateControl' :: NonEmpty CreateControlMappingSource
controlMappingSources =
        forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty CreateControlMappingSource
pControlMappingSources_
    }

-- | The recommended actions to carry out if the control isn\'t fulfilled.
createControl_actionPlanInstructions :: Lens.Lens' CreateControl (Prelude.Maybe Prelude.Text)
createControl_actionPlanInstructions :: Lens' CreateControl (Maybe Text)
createControl_actionPlanInstructions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateControl' {Maybe Text
actionPlanInstructions :: Maybe Text
$sel:actionPlanInstructions:CreateControl' :: CreateControl -> Maybe Text
actionPlanInstructions} -> Maybe Text
actionPlanInstructions) (\s :: CreateControl
s@CreateControl' {} Maybe Text
a -> CreateControl
s {$sel:actionPlanInstructions:CreateControl' :: Maybe Text
actionPlanInstructions = Maybe Text
a} :: CreateControl)

-- | The title of the action plan for remediating the control.
createControl_actionPlanTitle :: Lens.Lens' CreateControl (Prelude.Maybe Prelude.Text)
createControl_actionPlanTitle :: Lens' CreateControl (Maybe Text)
createControl_actionPlanTitle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateControl' {Maybe Text
actionPlanTitle :: Maybe Text
$sel:actionPlanTitle:CreateControl' :: CreateControl -> Maybe Text
actionPlanTitle} -> Maybe Text
actionPlanTitle) (\s :: CreateControl
s@CreateControl' {} Maybe Text
a -> CreateControl
s {$sel:actionPlanTitle:CreateControl' :: Maybe Text
actionPlanTitle = Maybe Text
a} :: CreateControl)

-- | The description of the control.
createControl_description :: Lens.Lens' CreateControl (Prelude.Maybe Prelude.Text)
createControl_description :: Lens' CreateControl (Maybe Text)
createControl_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateControl' {Maybe Text
description :: Maybe Text
$sel:description:CreateControl' :: CreateControl -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateControl
s@CreateControl' {} Maybe Text
a -> CreateControl
s {$sel:description:CreateControl' :: Maybe Text
description = Maybe Text
a} :: CreateControl)

-- | The tags that are associated with the control.
createControl_tags :: Lens.Lens' CreateControl (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createControl_tags :: Lens' CreateControl (Maybe (HashMap Text Text))
createControl_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateControl' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateControl' :: CreateControl -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateControl
s@CreateControl' {} Maybe (HashMap Text Text)
a -> CreateControl
s {$sel:tags:CreateControl' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateControl) 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 steps to follow to determine if the control is satisfied.
createControl_testingInformation :: Lens.Lens' CreateControl (Prelude.Maybe Prelude.Text)
createControl_testingInformation :: Lens' CreateControl (Maybe Text)
createControl_testingInformation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateControl' {Maybe Text
testingInformation :: Maybe Text
$sel:testingInformation:CreateControl' :: CreateControl -> Maybe Text
testingInformation} -> Maybe Text
testingInformation) (\s :: CreateControl
s@CreateControl' {} Maybe Text
a -> CreateControl
s {$sel:testingInformation:CreateControl' :: Maybe Text
testingInformation = Maybe Text
a} :: CreateControl)

-- | The name of the control.
createControl_name :: Lens.Lens' CreateControl Prelude.Text
createControl_name :: Lens' CreateControl Text
createControl_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateControl' {Text
name :: Text
$sel:name:CreateControl' :: CreateControl -> Text
name} -> Text
name) (\s :: CreateControl
s@CreateControl' {} Text
a -> CreateControl
s {$sel:name:CreateControl' :: Text
name = Text
a} :: CreateControl)

-- | The data mapping sources for the control.
createControl_controlMappingSources :: Lens.Lens' CreateControl (Prelude.NonEmpty CreateControlMappingSource)
createControl_controlMappingSources :: Lens' CreateControl (NonEmpty CreateControlMappingSource)
createControl_controlMappingSources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateControl' {NonEmpty CreateControlMappingSource
controlMappingSources :: NonEmpty CreateControlMappingSource
$sel:controlMappingSources:CreateControl' :: CreateControl -> NonEmpty CreateControlMappingSource
controlMappingSources} -> NonEmpty CreateControlMappingSource
controlMappingSources) (\s :: CreateControl
s@CreateControl' {} NonEmpty CreateControlMappingSource
a -> CreateControl
s {$sel:controlMappingSources:CreateControl' :: NonEmpty CreateControlMappingSource
controlMappingSources = NonEmpty CreateControlMappingSource
a} :: CreateControl) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateControl where
  type
    AWSResponse CreateControl =
      CreateControlResponse
  request :: (Service -> Service) -> CreateControl -> Request CreateControl
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 CreateControl
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateControl)))
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 Control -> Int -> CreateControlResponse
CreateControlResponse'
            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
"control")
            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 CreateControl where
  hashWithSalt :: Int -> CreateControl -> Int
hashWithSalt Int
_salt CreateControl' {Maybe Text
Maybe (HashMap Text Text)
NonEmpty CreateControlMappingSource
Text
controlMappingSources :: NonEmpty CreateControlMappingSource
name :: Text
testingInformation :: Maybe Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
actionPlanTitle :: Maybe Text
actionPlanInstructions :: Maybe Text
$sel:controlMappingSources:CreateControl' :: CreateControl -> NonEmpty CreateControlMappingSource
$sel:name:CreateControl' :: CreateControl -> Text
$sel:testingInformation:CreateControl' :: CreateControl -> Maybe Text
$sel:tags:CreateControl' :: CreateControl -> Maybe (HashMap Text Text)
$sel:description:CreateControl' :: CreateControl -> Maybe Text
$sel:actionPlanTitle:CreateControl' :: CreateControl -> Maybe Text
$sel:actionPlanInstructions:CreateControl' :: CreateControl -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
actionPlanInstructions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
actionPlanTitle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
testingInformation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty CreateControlMappingSource
controlMappingSources

instance Prelude.NFData CreateControl where
  rnf :: CreateControl -> ()
rnf CreateControl' {Maybe Text
Maybe (HashMap Text Text)
NonEmpty CreateControlMappingSource
Text
controlMappingSources :: NonEmpty CreateControlMappingSource
name :: Text
testingInformation :: Maybe Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
actionPlanTitle :: Maybe Text
actionPlanInstructions :: Maybe Text
$sel:controlMappingSources:CreateControl' :: CreateControl -> NonEmpty CreateControlMappingSource
$sel:name:CreateControl' :: CreateControl -> Text
$sel:testingInformation:CreateControl' :: CreateControl -> Maybe Text
$sel:tags:CreateControl' :: CreateControl -> Maybe (HashMap Text Text)
$sel:description:CreateControl' :: CreateControl -> Maybe Text
$sel:actionPlanTitle:CreateControl' :: CreateControl -> Maybe Text
$sel:actionPlanInstructions:CreateControl' :: CreateControl -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
actionPlanInstructions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
actionPlanTitle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
testingInformation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty CreateControlMappingSource
controlMappingSources

instance Data.ToHeaders CreateControl where
  toHeaders :: CreateControl -> 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 CreateControl where
  toJSON :: CreateControl -> Value
toJSON CreateControl' {Maybe Text
Maybe (HashMap Text Text)
NonEmpty CreateControlMappingSource
Text
controlMappingSources :: NonEmpty CreateControlMappingSource
name :: Text
testingInformation :: Maybe Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
actionPlanTitle :: Maybe Text
actionPlanInstructions :: Maybe Text
$sel:controlMappingSources:CreateControl' :: CreateControl -> NonEmpty CreateControlMappingSource
$sel:name:CreateControl' :: CreateControl -> Text
$sel:testingInformation:CreateControl' :: CreateControl -> Maybe Text
$sel:tags:CreateControl' :: CreateControl -> Maybe (HashMap Text Text)
$sel:description:CreateControl' :: CreateControl -> Maybe Text
$sel:actionPlanTitle:CreateControl' :: CreateControl -> Maybe Text
$sel:actionPlanInstructions:CreateControl' :: CreateControl -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"actionPlanInstructions" 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
actionPlanInstructions,
            (Key
"actionPlanTitle" 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
actionPlanTitle,
            (Key
"description" 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
description,
            (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 (HashMap Text Text)
tags,
            (Key
"testingInformation" 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
testingInformation,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"controlMappingSources"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty CreateControlMappingSource
controlMappingSources
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateControlResponse' 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:
--
-- 'control', 'createControlResponse_control' - The new control that the @CreateControl@ API returned.
--
-- 'httpStatus', 'createControlResponse_httpStatus' - The response's http status code.
newCreateControlResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateControlResponse
newCreateControlResponse :: Int -> CreateControlResponse
newCreateControlResponse Int
pHttpStatus_ =
  CreateControlResponse'
    { $sel:control:CreateControlResponse' :: Maybe Control
control = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateControlResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The new control that the @CreateControl@ API returned.
createControlResponse_control :: Lens.Lens' CreateControlResponse (Prelude.Maybe Control)
createControlResponse_control :: Lens' CreateControlResponse (Maybe Control)
createControlResponse_control = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateControlResponse' {Maybe Control
control :: Maybe Control
$sel:control:CreateControlResponse' :: CreateControlResponse -> Maybe Control
control} -> Maybe Control
control) (\s :: CreateControlResponse
s@CreateControlResponse' {} Maybe Control
a -> CreateControlResponse
s {$sel:control:CreateControlResponse' :: Maybe Control
control = Maybe Control
a} :: CreateControlResponse)

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

instance Prelude.NFData CreateControlResponse where
  rnf :: CreateControlResponse -> ()
rnf CreateControlResponse' {Int
Maybe Control
httpStatus :: Int
control :: Maybe Control
$sel:httpStatus:CreateControlResponse' :: CreateControlResponse -> Int
$sel:control:CreateControlResponse' :: CreateControlResponse -> Maybe Control
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Control
control
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus