{-# 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.Discovery.AssociateConfigurationItemsToApplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates one or more configuration items with an application.
module Amazonka.Discovery.AssociateConfigurationItemsToApplication
  ( -- * Creating a Request
    AssociateConfigurationItemsToApplication (..),
    newAssociateConfigurationItemsToApplication,

    -- * Request Lenses
    associateConfigurationItemsToApplication_applicationConfigurationId,
    associateConfigurationItemsToApplication_configurationIds,

    -- * Destructuring the Response
    AssociateConfigurationItemsToApplicationResponse (..),
    newAssociateConfigurationItemsToApplicationResponse,

    -- * Response Lenses
    associateConfigurationItemsToApplicationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newAssociateConfigurationItemsToApplication' smart constructor.
data AssociateConfigurationItemsToApplication = AssociateConfigurationItemsToApplication'
  { -- | The configuration ID of an application with which items are to be
    -- associated.
    AssociateConfigurationItemsToApplication -> Text
applicationConfigurationId :: Prelude.Text,
    -- | The ID of each configuration item to be associated with an application.
    AssociateConfigurationItemsToApplication -> [Text]
configurationIds :: [Prelude.Text]
  }
  deriving (AssociateConfigurationItemsToApplication
-> AssociateConfigurationItemsToApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateConfigurationItemsToApplication
-> AssociateConfigurationItemsToApplication -> Bool
$c/= :: AssociateConfigurationItemsToApplication
-> AssociateConfigurationItemsToApplication -> Bool
== :: AssociateConfigurationItemsToApplication
-> AssociateConfigurationItemsToApplication -> Bool
$c== :: AssociateConfigurationItemsToApplication
-> AssociateConfigurationItemsToApplication -> Bool
Prelude.Eq, ReadPrec [AssociateConfigurationItemsToApplication]
ReadPrec AssociateConfigurationItemsToApplication
Int -> ReadS AssociateConfigurationItemsToApplication
ReadS [AssociateConfigurationItemsToApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateConfigurationItemsToApplication]
$creadListPrec :: ReadPrec [AssociateConfigurationItemsToApplication]
readPrec :: ReadPrec AssociateConfigurationItemsToApplication
$creadPrec :: ReadPrec AssociateConfigurationItemsToApplication
readList :: ReadS [AssociateConfigurationItemsToApplication]
$creadList :: ReadS [AssociateConfigurationItemsToApplication]
readsPrec :: Int -> ReadS AssociateConfigurationItemsToApplication
$creadsPrec :: Int -> ReadS AssociateConfigurationItemsToApplication
Prelude.Read, Int -> AssociateConfigurationItemsToApplication -> ShowS
[AssociateConfigurationItemsToApplication] -> ShowS
AssociateConfigurationItemsToApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateConfigurationItemsToApplication] -> ShowS
$cshowList :: [AssociateConfigurationItemsToApplication] -> ShowS
show :: AssociateConfigurationItemsToApplication -> String
$cshow :: AssociateConfigurationItemsToApplication -> String
showsPrec :: Int -> AssociateConfigurationItemsToApplication -> ShowS
$cshowsPrec :: Int -> AssociateConfigurationItemsToApplication -> ShowS
Prelude.Show, forall x.
Rep AssociateConfigurationItemsToApplication x
-> AssociateConfigurationItemsToApplication
forall x.
AssociateConfigurationItemsToApplication
-> Rep AssociateConfigurationItemsToApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateConfigurationItemsToApplication x
-> AssociateConfigurationItemsToApplication
$cfrom :: forall x.
AssociateConfigurationItemsToApplication
-> Rep AssociateConfigurationItemsToApplication x
Prelude.Generic)

-- |
-- Create a value of 'AssociateConfigurationItemsToApplication' 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:
--
-- 'applicationConfigurationId', 'associateConfigurationItemsToApplication_applicationConfigurationId' - The configuration ID of an application with which items are to be
-- associated.
--
-- 'configurationIds', 'associateConfigurationItemsToApplication_configurationIds' - The ID of each configuration item to be associated with an application.
newAssociateConfigurationItemsToApplication ::
  -- | 'applicationConfigurationId'
  Prelude.Text ->
  AssociateConfigurationItemsToApplication
newAssociateConfigurationItemsToApplication :: Text -> AssociateConfigurationItemsToApplication
newAssociateConfigurationItemsToApplication
  Text
pApplicationConfigurationId_ =
    AssociateConfigurationItemsToApplication'
      { $sel:applicationConfigurationId:AssociateConfigurationItemsToApplication' :: Text
applicationConfigurationId =
          Text
pApplicationConfigurationId_,
        $sel:configurationIds:AssociateConfigurationItemsToApplication' :: [Text]
configurationIds = forall a. Monoid a => a
Prelude.mempty
      }

-- | The configuration ID of an application with which items are to be
-- associated.
associateConfigurationItemsToApplication_applicationConfigurationId :: Lens.Lens' AssociateConfigurationItemsToApplication Prelude.Text
associateConfigurationItemsToApplication_applicationConfigurationId :: Lens' AssociateConfigurationItemsToApplication Text
associateConfigurationItemsToApplication_applicationConfigurationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateConfigurationItemsToApplication' {Text
applicationConfigurationId :: Text
$sel:applicationConfigurationId:AssociateConfigurationItemsToApplication' :: AssociateConfigurationItemsToApplication -> Text
applicationConfigurationId} -> Text
applicationConfigurationId) (\s :: AssociateConfigurationItemsToApplication
s@AssociateConfigurationItemsToApplication' {} Text
a -> AssociateConfigurationItemsToApplication
s {$sel:applicationConfigurationId:AssociateConfigurationItemsToApplication' :: Text
applicationConfigurationId = Text
a} :: AssociateConfigurationItemsToApplication)

-- | The ID of each configuration item to be associated with an application.
associateConfigurationItemsToApplication_configurationIds :: Lens.Lens' AssociateConfigurationItemsToApplication [Prelude.Text]
associateConfigurationItemsToApplication_configurationIds :: Lens' AssociateConfigurationItemsToApplication [Text]
associateConfigurationItemsToApplication_configurationIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateConfigurationItemsToApplication' {[Text]
configurationIds :: [Text]
$sel:configurationIds:AssociateConfigurationItemsToApplication' :: AssociateConfigurationItemsToApplication -> [Text]
configurationIds} -> [Text]
configurationIds) (\s :: AssociateConfigurationItemsToApplication
s@AssociateConfigurationItemsToApplication' {} [Text]
a -> AssociateConfigurationItemsToApplication
s {$sel:configurationIds:AssociateConfigurationItemsToApplication' :: [Text]
configurationIds = [Text]
a} :: AssociateConfigurationItemsToApplication) 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
    AssociateConfigurationItemsToApplication
  where
  type
    AWSResponse
      AssociateConfigurationItemsToApplication =
      AssociateConfigurationItemsToApplicationResponse
  request :: (Service -> Service)
-> AssociateConfigurationItemsToApplication
-> Request AssociateConfigurationItemsToApplication
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 AssociateConfigurationItemsToApplication
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse AssociateConfigurationItemsToApplication)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AssociateConfigurationItemsToApplicationResponse
AssociateConfigurationItemsToApplicationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance
  Prelude.Hashable
    AssociateConfigurationItemsToApplication
  where
  hashWithSalt :: Int -> AssociateConfigurationItemsToApplication -> Int
hashWithSalt
    Int
_salt
    AssociateConfigurationItemsToApplication' {[Text]
Text
configurationIds :: [Text]
applicationConfigurationId :: Text
$sel:configurationIds:AssociateConfigurationItemsToApplication' :: AssociateConfigurationItemsToApplication -> [Text]
$sel:applicationConfigurationId:AssociateConfigurationItemsToApplication' :: AssociateConfigurationItemsToApplication -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationConfigurationId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
configurationIds

instance
  Prelude.NFData
    AssociateConfigurationItemsToApplication
  where
  rnf :: AssociateConfigurationItemsToApplication -> ()
rnf AssociateConfigurationItemsToApplication' {[Text]
Text
configurationIds :: [Text]
applicationConfigurationId :: Text
$sel:configurationIds:AssociateConfigurationItemsToApplication' :: AssociateConfigurationItemsToApplication -> [Text]
$sel:applicationConfigurationId:AssociateConfigurationItemsToApplication' :: AssociateConfigurationItemsToApplication -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationConfigurationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
configurationIds

instance
  Data.ToHeaders
    AssociateConfigurationItemsToApplication
  where
  toHeaders :: AssociateConfigurationItemsToApplication -> 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
"AWSPoseidonService_V2015_11_01.AssociateConfigurationItemsToApplication" ::
                          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
    AssociateConfigurationItemsToApplication
  where
  toJSON :: AssociateConfigurationItemsToApplication -> Value
toJSON AssociateConfigurationItemsToApplication' {[Text]
Text
configurationIds :: [Text]
applicationConfigurationId :: Text
$sel:configurationIds:AssociateConfigurationItemsToApplication' :: AssociateConfigurationItemsToApplication -> [Text]
$sel:applicationConfigurationId:AssociateConfigurationItemsToApplication' :: AssociateConfigurationItemsToApplication -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"applicationConfigurationId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationConfigurationId
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"configurationIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
configurationIds)
          ]
      )

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

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

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

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

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

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