{-# 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.DataSync.CreateAgent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Activates an DataSync agent that you have deployed in your storage
-- environment. The activation process associates your agent with your
-- account. In the activation process, you specify information such as the
-- Amazon Web Services Region that you want to activate the agent in. You
-- activate the agent in the Amazon Web Services Region where your target
-- locations (in Amazon S3 or Amazon EFS) reside. Your tasks are created in
-- this Amazon Web Services Region.
--
-- You can activate the agent in a VPC (virtual private cloud) or provide
-- the agent access to a VPC endpoint so you can run tasks without going
-- over the public internet.
--
-- You can use an agent for more than one location. If a task uses multiple
-- agents, all of them need to have status AVAILABLE for the task to run.
-- If you use multiple agents for a source location, the status of all the
-- agents must be AVAILABLE for the task to run.
--
-- Agents are automatically updated by Amazon Web Services on a regular
-- basis, using a mechanism that ensures minimal interruption to your
-- tasks.
module Amazonka.DataSync.CreateAgent
  ( -- * Creating a Request
    CreateAgent (..),
    newCreateAgent,

    -- * Request Lenses
    createAgent_agentName,
    createAgent_securityGroupArns,
    createAgent_subnetArns,
    createAgent_tags,
    createAgent_vpcEndpointId,
    createAgent_activationKey,

    -- * Destructuring the Response
    CreateAgentResponse (..),
    newCreateAgentResponse,

    -- * Response Lenses
    createAgentResponse_agentArn,
    createAgentResponse_httpStatus,
  )
where

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

-- | CreateAgentRequest
--
-- /See:/ 'newCreateAgent' smart constructor.
data CreateAgent = CreateAgent'
  { -- | The name you configured for your agent. This value is a text reference
    -- that is used to identify the agent in the console.
    CreateAgent -> Maybe Text
agentName :: Prelude.Maybe Prelude.Text,
    -- | The ARNs of the security groups used to protect your data transfer task
    -- subnets. See
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/API_Ec2Config.html#DataSync-Type-Ec2Config-SecurityGroupArns SecurityGroupArns>.
    CreateAgent -> Maybe (NonEmpty Text)
securityGroupArns :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The Amazon Resource Names (ARNs) of the subnets in which DataSync will
    -- create elastic network interfaces for each data transfer task. The agent
    -- that runs a task must be private. When you start a task that is
    -- associated with an agent created in a VPC, or one that has access to an
    -- IP address in a VPC, then the task is also private. In this case,
    -- DataSync creates four network interfaces for each task in your subnet.
    -- For a data transfer to work, the agent must be able to route to all
    -- these four network interfaces.
    CreateAgent -> Maybe (NonEmpty Text)
subnetArns :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The key-value pair that represents the tag that you want to associate
    -- with the agent. The value can be an empty string. This value helps you
    -- manage, filter, and search for your agents.
    --
    -- Valid characters for key and value are letters, spaces, and numbers
    -- representable in UTF-8 format, and the following special characters: + -
    -- = . _ : \/ \@.
    CreateAgent -> Maybe [TagListEntry]
tags :: Prelude.Maybe [TagListEntry],
    -- | The ID of the VPC (virtual private cloud) endpoint that the agent has
    -- access to. This is the client-side VPC endpoint, also called a
    -- PrivateLink. If you don\'t have a PrivateLink VPC endpoint, see
    -- <https://docs.aws.amazon.com/vpc/latest/userguide/endpoint-service.html#create-endpoint-service Creating a VPC Endpoint Service Configuration>
    -- in the Amazon VPC User Guide.
    --
    -- VPC endpoint ID looks like this: @vpce-01234d5aff67890e1@.
    CreateAgent -> Maybe Text
vpcEndpointId :: Prelude.Maybe Prelude.Text,
    -- | Your agent activation key. You can get the activation key either by
    -- sending an HTTP GET request with redirects that enable you to get the
    -- agent IP address (port 80). Alternatively, you can get it from the
    -- DataSync console.
    --
    -- The redirect URL returned in the response provides you the activation
    -- key for your agent in the query string parameter @activationKey@. It
    -- might also include other activation-related parameters; however, these
    -- are merely defaults. The arguments you pass to this API call determine
    -- the actual configuration of your agent.
    --
    -- For more information, see Activating an Agent in the /DataSync User
    -- Guide./
    CreateAgent -> Text
activationKey :: Prelude.Text
  }
  deriving (CreateAgent -> CreateAgent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAgent -> CreateAgent -> Bool
$c/= :: CreateAgent -> CreateAgent -> Bool
== :: CreateAgent -> CreateAgent -> Bool
$c== :: CreateAgent -> CreateAgent -> Bool
Prelude.Eq, ReadPrec [CreateAgent]
ReadPrec CreateAgent
Int -> ReadS CreateAgent
ReadS [CreateAgent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAgent]
$creadListPrec :: ReadPrec [CreateAgent]
readPrec :: ReadPrec CreateAgent
$creadPrec :: ReadPrec CreateAgent
readList :: ReadS [CreateAgent]
$creadList :: ReadS [CreateAgent]
readsPrec :: Int -> ReadS CreateAgent
$creadsPrec :: Int -> ReadS CreateAgent
Prelude.Read, Int -> CreateAgent -> ShowS
[CreateAgent] -> ShowS
CreateAgent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAgent] -> ShowS
$cshowList :: [CreateAgent] -> ShowS
show :: CreateAgent -> String
$cshow :: CreateAgent -> String
showsPrec :: Int -> CreateAgent -> ShowS
$cshowsPrec :: Int -> CreateAgent -> ShowS
Prelude.Show, forall x. Rep CreateAgent x -> CreateAgent
forall x. CreateAgent -> Rep CreateAgent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAgent x -> CreateAgent
$cfrom :: forall x. CreateAgent -> Rep CreateAgent x
Prelude.Generic)

-- |
-- Create a value of 'CreateAgent' 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:
--
-- 'agentName', 'createAgent_agentName' - The name you configured for your agent. This value is a text reference
-- that is used to identify the agent in the console.
--
-- 'securityGroupArns', 'createAgent_securityGroupArns' - The ARNs of the security groups used to protect your data transfer task
-- subnets. See
-- <https://docs.aws.amazon.com/datasync/latest/userguide/API_Ec2Config.html#DataSync-Type-Ec2Config-SecurityGroupArns SecurityGroupArns>.
--
-- 'subnetArns', 'createAgent_subnetArns' - The Amazon Resource Names (ARNs) of the subnets in which DataSync will
-- create elastic network interfaces for each data transfer task. The agent
-- that runs a task must be private. When you start a task that is
-- associated with an agent created in a VPC, or one that has access to an
-- IP address in a VPC, then the task is also private. In this case,
-- DataSync creates four network interfaces for each task in your subnet.
-- For a data transfer to work, the agent must be able to route to all
-- these four network interfaces.
--
-- 'tags', 'createAgent_tags' - The key-value pair that represents the tag that you want to associate
-- with the agent. The value can be an empty string. This value helps you
-- manage, filter, and search for your agents.
--
-- Valid characters for key and value are letters, spaces, and numbers
-- representable in UTF-8 format, and the following special characters: + -
-- = . _ : \/ \@.
--
-- 'vpcEndpointId', 'createAgent_vpcEndpointId' - The ID of the VPC (virtual private cloud) endpoint that the agent has
-- access to. This is the client-side VPC endpoint, also called a
-- PrivateLink. If you don\'t have a PrivateLink VPC endpoint, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/endpoint-service.html#create-endpoint-service Creating a VPC Endpoint Service Configuration>
-- in the Amazon VPC User Guide.
--
-- VPC endpoint ID looks like this: @vpce-01234d5aff67890e1@.
--
-- 'activationKey', 'createAgent_activationKey' - Your agent activation key. You can get the activation key either by
-- sending an HTTP GET request with redirects that enable you to get the
-- agent IP address (port 80). Alternatively, you can get it from the
-- DataSync console.
--
-- The redirect URL returned in the response provides you the activation
-- key for your agent in the query string parameter @activationKey@. It
-- might also include other activation-related parameters; however, these
-- are merely defaults. The arguments you pass to this API call determine
-- the actual configuration of your agent.
--
-- For more information, see Activating an Agent in the /DataSync User
-- Guide./
newCreateAgent ::
  -- | 'activationKey'
  Prelude.Text ->
  CreateAgent
newCreateAgent :: Text -> CreateAgent
newCreateAgent Text
pActivationKey_ =
  CreateAgent'
    { $sel:agentName:CreateAgent' :: Maybe Text
agentName = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroupArns:CreateAgent' :: Maybe (NonEmpty Text)
securityGroupArns = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetArns:CreateAgent' :: Maybe (NonEmpty Text)
subnetArns = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateAgent' :: Maybe [TagListEntry]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcEndpointId:CreateAgent' :: Maybe Text
vpcEndpointId = forall a. Maybe a
Prelude.Nothing,
      $sel:activationKey:CreateAgent' :: Text
activationKey = Text
pActivationKey_
    }

-- | The name you configured for your agent. This value is a text reference
-- that is used to identify the agent in the console.
createAgent_agentName :: Lens.Lens' CreateAgent (Prelude.Maybe Prelude.Text)
createAgent_agentName :: Lens' CreateAgent (Maybe Text)
createAgent_agentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAgent' {Maybe Text
agentName :: Maybe Text
$sel:agentName:CreateAgent' :: CreateAgent -> Maybe Text
agentName} -> Maybe Text
agentName) (\s :: CreateAgent
s@CreateAgent' {} Maybe Text
a -> CreateAgent
s {$sel:agentName:CreateAgent' :: Maybe Text
agentName = Maybe Text
a} :: CreateAgent)

-- | The ARNs of the security groups used to protect your data transfer task
-- subnets. See
-- <https://docs.aws.amazon.com/datasync/latest/userguide/API_Ec2Config.html#DataSync-Type-Ec2Config-SecurityGroupArns SecurityGroupArns>.
createAgent_securityGroupArns :: Lens.Lens' CreateAgent (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
createAgent_securityGroupArns :: Lens' CreateAgent (Maybe (NonEmpty Text))
createAgent_securityGroupArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAgent' {Maybe (NonEmpty Text)
securityGroupArns :: Maybe (NonEmpty Text)
$sel:securityGroupArns:CreateAgent' :: CreateAgent -> Maybe (NonEmpty Text)
securityGroupArns} -> Maybe (NonEmpty Text)
securityGroupArns) (\s :: CreateAgent
s@CreateAgent' {} Maybe (NonEmpty Text)
a -> CreateAgent
s {$sel:securityGroupArns:CreateAgent' :: Maybe (NonEmpty Text)
securityGroupArns = Maybe (NonEmpty Text)
a} :: CreateAgent) 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 Amazon Resource Names (ARNs) of the subnets in which DataSync will
-- create elastic network interfaces for each data transfer task. The agent
-- that runs a task must be private. When you start a task that is
-- associated with an agent created in a VPC, or one that has access to an
-- IP address in a VPC, then the task is also private. In this case,
-- DataSync creates four network interfaces for each task in your subnet.
-- For a data transfer to work, the agent must be able to route to all
-- these four network interfaces.
createAgent_subnetArns :: Lens.Lens' CreateAgent (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
createAgent_subnetArns :: Lens' CreateAgent (Maybe (NonEmpty Text))
createAgent_subnetArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAgent' {Maybe (NonEmpty Text)
subnetArns :: Maybe (NonEmpty Text)
$sel:subnetArns:CreateAgent' :: CreateAgent -> Maybe (NonEmpty Text)
subnetArns} -> Maybe (NonEmpty Text)
subnetArns) (\s :: CreateAgent
s@CreateAgent' {} Maybe (NonEmpty Text)
a -> CreateAgent
s {$sel:subnetArns:CreateAgent' :: Maybe (NonEmpty Text)
subnetArns = Maybe (NonEmpty Text)
a} :: CreateAgent) 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 key-value pair that represents the tag that you want to associate
-- with the agent. The value can be an empty string. This value helps you
-- manage, filter, and search for your agents.
--
-- Valid characters for key and value are letters, spaces, and numbers
-- representable in UTF-8 format, and the following special characters: + -
-- = . _ : \/ \@.
createAgent_tags :: Lens.Lens' CreateAgent (Prelude.Maybe [TagListEntry])
createAgent_tags :: Lens' CreateAgent (Maybe [TagListEntry])
createAgent_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAgent' {Maybe [TagListEntry]
tags :: Maybe [TagListEntry]
$sel:tags:CreateAgent' :: CreateAgent -> Maybe [TagListEntry]
tags} -> Maybe [TagListEntry]
tags) (\s :: CreateAgent
s@CreateAgent' {} Maybe [TagListEntry]
a -> CreateAgent
s {$sel:tags:CreateAgent' :: Maybe [TagListEntry]
tags = Maybe [TagListEntry]
a} :: CreateAgent) 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 ID of the VPC (virtual private cloud) endpoint that the agent has
-- access to. This is the client-side VPC endpoint, also called a
-- PrivateLink. If you don\'t have a PrivateLink VPC endpoint, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/endpoint-service.html#create-endpoint-service Creating a VPC Endpoint Service Configuration>
-- in the Amazon VPC User Guide.
--
-- VPC endpoint ID looks like this: @vpce-01234d5aff67890e1@.
createAgent_vpcEndpointId :: Lens.Lens' CreateAgent (Prelude.Maybe Prelude.Text)
createAgent_vpcEndpointId :: Lens' CreateAgent (Maybe Text)
createAgent_vpcEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAgent' {Maybe Text
vpcEndpointId :: Maybe Text
$sel:vpcEndpointId:CreateAgent' :: CreateAgent -> Maybe Text
vpcEndpointId} -> Maybe Text
vpcEndpointId) (\s :: CreateAgent
s@CreateAgent' {} Maybe Text
a -> CreateAgent
s {$sel:vpcEndpointId:CreateAgent' :: Maybe Text
vpcEndpointId = Maybe Text
a} :: CreateAgent)

-- | Your agent activation key. You can get the activation key either by
-- sending an HTTP GET request with redirects that enable you to get the
-- agent IP address (port 80). Alternatively, you can get it from the
-- DataSync console.
--
-- The redirect URL returned in the response provides you the activation
-- key for your agent in the query string parameter @activationKey@. It
-- might also include other activation-related parameters; however, these
-- are merely defaults. The arguments you pass to this API call determine
-- the actual configuration of your agent.
--
-- For more information, see Activating an Agent in the /DataSync User
-- Guide./
createAgent_activationKey :: Lens.Lens' CreateAgent Prelude.Text
createAgent_activationKey :: Lens' CreateAgent Text
createAgent_activationKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAgent' {Text
activationKey :: Text
$sel:activationKey:CreateAgent' :: CreateAgent -> Text
activationKey} -> Text
activationKey) (\s :: CreateAgent
s@CreateAgent' {} Text
a -> CreateAgent
s {$sel:activationKey:CreateAgent' :: Text
activationKey = Text
a} :: CreateAgent)

instance Core.AWSRequest CreateAgent where
  type AWSResponse CreateAgent = CreateAgentResponse
  request :: (Service -> Service) -> CreateAgent -> Request CreateAgent
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 CreateAgent
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateAgent)))
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 -> Int -> CreateAgentResponse
CreateAgentResponse'
            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
"AgentArn")
            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 CreateAgent where
  hashWithSalt :: Int -> CreateAgent -> Int
hashWithSalt Int
_salt CreateAgent' {Maybe [TagListEntry]
Maybe (NonEmpty Text)
Maybe Text
Text
activationKey :: Text
vpcEndpointId :: Maybe Text
tags :: Maybe [TagListEntry]
subnetArns :: Maybe (NonEmpty Text)
securityGroupArns :: Maybe (NonEmpty Text)
agentName :: Maybe Text
$sel:activationKey:CreateAgent' :: CreateAgent -> Text
$sel:vpcEndpointId:CreateAgent' :: CreateAgent -> Maybe Text
$sel:tags:CreateAgent' :: CreateAgent -> Maybe [TagListEntry]
$sel:subnetArns:CreateAgent' :: CreateAgent -> Maybe (NonEmpty Text)
$sel:securityGroupArns:CreateAgent' :: CreateAgent -> Maybe (NonEmpty Text)
$sel:agentName:CreateAgent' :: CreateAgent -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
agentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
securityGroupArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
subnetArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagListEntry]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpcEndpointId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
activationKey

instance Prelude.NFData CreateAgent where
  rnf :: CreateAgent -> ()
rnf CreateAgent' {Maybe [TagListEntry]
Maybe (NonEmpty Text)
Maybe Text
Text
activationKey :: Text
vpcEndpointId :: Maybe Text
tags :: Maybe [TagListEntry]
subnetArns :: Maybe (NonEmpty Text)
securityGroupArns :: Maybe (NonEmpty Text)
agentName :: Maybe Text
$sel:activationKey:CreateAgent' :: CreateAgent -> Text
$sel:vpcEndpointId:CreateAgent' :: CreateAgent -> Maybe Text
$sel:tags:CreateAgent' :: CreateAgent -> Maybe [TagListEntry]
$sel:subnetArns:CreateAgent' :: CreateAgent -> Maybe (NonEmpty Text)
$sel:securityGroupArns:CreateAgent' :: CreateAgent -> Maybe (NonEmpty Text)
$sel:agentName:CreateAgent' :: CreateAgent -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
agentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
securityGroupArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
subnetArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagListEntry]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vpcEndpointId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
activationKey

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

instance Data.ToJSON CreateAgent where
  toJSON :: CreateAgent -> Value
toJSON CreateAgent' {Maybe [TagListEntry]
Maybe (NonEmpty Text)
Maybe Text
Text
activationKey :: Text
vpcEndpointId :: Maybe Text
tags :: Maybe [TagListEntry]
subnetArns :: Maybe (NonEmpty Text)
securityGroupArns :: Maybe (NonEmpty Text)
agentName :: Maybe Text
$sel:activationKey:CreateAgent' :: CreateAgent -> Text
$sel:vpcEndpointId:CreateAgent' :: CreateAgent -> Maybe Text
$sel:tags:CreateAgent' :: CreateAgent -> Maybe [TagListEntry]
$sel:subnetArns:CreateAgent' :: CreateAgent -> Maybe (NonEmpty Text)
$sel:securityGroupArns:CreateAgent' :: CreateAgent -> Maybe (NonEmpty Text)
$sel:agentName:CreateAgent' :: CreateAgent -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AgentName" 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
agentName,
            (Key
"SecurityGroupArns" 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 (NonEmpty Text)
securityGroupArns,
            (Key
"SubnetArns" 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 (NonEmpty Text)
subnetArns,
            (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 [TagListEntry]
tags,
            (Key
"VpcEndpointId" 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
vpcEndpointId,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ActivationKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
activationKey)
          ]
      )

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

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

-- | CreateAgentResponse
--
-- /See:/ 'newCreateAgentResponse' smart constructor.
data CreateAgentResponse = CreateAgentResponse'
  { -- | The Amazon Resource Name (ARN) of the agent. Use the @ListAgents@
    -- operation to return a list of agents for your account and Amazon Web
    -- Services Region.
    CreateAgentResponse -> Maybe Text
agentArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateAgentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateAgentResponse -> CreateAgentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAgentResponse -> CreateAgentResponse -> Bool
$c/= :: CreateAgentResponse -> CreateAgentResponse -> Bool
== :: CreateAgentResponse -> CreateAgentResponse -> Bool
$c== :: CreateAgentResponse -> CreateAgentResponse -> Bool
Prelude.Eq, ReadPrec [CreateAgentResponse]
ReadPrec CreateAgentResponse
Int -> ReadS CreateAgentResponse
ReadS [CreateAgentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAgentResponse]
$creadListPrec :: ReadPrec [CreateAgentResponse]
readPrec :: ReadPrec CreateAgentResponse
$creadPrec :: ReadPrec CreateAgentResponse
readList :: ReadS [CreateAgentResponse]
$creadList :: ReadS [CreateAgentResponse]
readsPrec :: Int -> ReadS CreateAgentResponse
$creadsPrec :: Int -> ReadS CreateAgentResponse
Prelude.Read, Int -> CreateAgentResponse -> ShowS
[CreateAgentResponse] -> ShowS
CreateAgentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAgentResponse] -> ShowS
$cshowList :: [CreateAgentResponse] -> ShowS
show :: CreateAgentResponse -> String
$cshow :: CreateAgentResponse -> String
showsPrec :: Int -> CreateAgentResponse -> ShowS
$cshowsPrec :: Int -> CreateAgentResponse -> ShowS
Prelude.Show, forall x. Rep CreateAgentResponse x -> CreateAgentResponse
forall x. CreateAgentResponse -> Rep CreateAgentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAgentResponse x -> CreateAgentResponse
$cfrom :: forall x. CreateAgentResponse -> Rep CreateAgentResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateAgentResponse' 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:
--
-- 'agentArn', 'createAgentResponse_agentArn' - The Amazon Resource Name (ARN) of the agent. Use the @ListAgents@
-- operation to return a list of agents for your account and Amazon Web
-- Services Region.
--
-- 'httpStatus', 'createAgentResponse_httpStatus' - The response's http status code.
newCreateAgentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateAgentResponse
newCreateAgentResponse :: Int -> CreateAgentResponse
newCreateAgentResponse Int
pHttpStatus_ =
  CreateAgentResponse'
    { $sel:agentArn:CreateAgentResponse' :: Maybe Text
agentArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateAgentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the agent. Use the @ListAgents@
-- operation to return a list of agents for your account and Amazon Web
-- Services Region.
createAgentResponse_agentArn :: Lens.Lens' CreateAgentResponse (Prelude.Maybe Prelude.Text)
createAgentResponse_agentArn :: Lens' CreateAgentResponse (Maybe Text)
createAgentResponse_agentArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAgentResponse' {Maybe Text
agentArn :: Maybe Text
$sel:agentArn:CreateAgentResponse' :: CreateAgentResponse -> Maybe Text
agentArn} -> Maybe Text
agentArn) (\s :: CreateAgentResponse
s@CreateAgentResponse' {} Maybe Text
a -> CreateAgentResponse
s {$sel:agentArn:CreateAgentResponse' :: Maybe Text
agentArn = Maybe Text
a} :: CreateAgentResponse)

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

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