{-# 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.SSM.CreateAssociationBatch
-- 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 the specified Amazon Web Services Systems Manager document
-- (SSM document) with the specified managed nodes or targets.
--
-- When you associate a document with one or more managed nodes using IDs
-- or tags, Amazon Web Services Systems Manager Agent (SSM Agent) running
-- on the managed node processes the document and configures the node as
-- specified.
--
-- If you associate a document with a managed node that already has an
-- associated document, the system returns the AssociationAlreadyExists
-- exception.
module Amazonka.SSM.CreateAssociationBatch
  ( -- * Creating a Request
    CreateAssociationBatch (..),
    newCreateAssociationBatch,

    -- * Request Lenses
    createAssociationBatch_entries,

    -- * Destructuring the Response
    CreateAssociationBatchResponse (..),
    newCreateAssociationBatchResponse,

    -- * Response Lenses
    createAssociationBatchResponse_failed,
    createAssociationBatchResponse_successful,
    createAssociationBatchResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateAssociationBatch' smart constructor.
data CreateAssociationBatch = CreateAssociationBatch'
  { -- | One or more associations.
    CreateAssociationBatch
-> NonEmpty CreateAssociationBatchRequestEntry
entries :: Prelude.NonEmpty CreateAssociationBatchRequestEntry
  }
  deriving (CreateAssociationBatch -> CreateAssociationBatch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAssociationBatch -> CreateAssociationBatch -> Bool
$c/= :: CreateAssociationBatch -> CreateAssociationBatch -> Bool
== :: CreateAssociationBatch -> CreateAssociationBatch -> Bool
$c== :: CreateAssociationBatch -> CreateAssociationBatch -> Bool
Prelude.Eq, Int -> CreateAssociationBatch -> ShowS
[CreateAssociationBatch] -> ShowS
CreateAssociationBatch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAssociationBatch] -> ShowS
$cshowList :: [CreateAssociationBatch] -> ShowS
show :: CreateAssociationBatch -> String
$cshow :: CreateAssociationBatch -> String
showsPrec :: Int -> CreateAssociationBatch -> ShowS
$cshowsPrec :: Int -> CreateAssociationBatch -> ShowS
Prelude.Show, forall x. Rep CreateAssociationBatch x -> CreateAssociationBatch
forall x. CreateAssociationBatch -> Rep CreateAssociationBatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAssociationBatch x -> CreateAssociationBatch
$cfrom :: forall x. CreateAssociationBatch -> Rep CreateAssociationBatch x
Prelude.Generic)

-- |
-- Create a value of 'CreateAssociationBatch' 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:
--
-- 'entries', 'createAssociationBatch_entries' - One or more associations.
newCreateAssociationBatch ::
  -- | 'entries'
  Prelude.NonEmpty CreateAssociationBatchRequestEntry ->
  CreateAssociationBatch
newCreateAssociationBatch :: NonEmpty CreateAssociationBatchRequestEntry
-> CreateAssociationBatch
newCreateAssociationBatch NonEmpty CreateAssociationBatchRequestEntry
pEntries_ =
  CreateAssociationBatch'
    { $sel:entries:CreateAssociationBatch' :: NonEmpty CreateAssociationBatchRequestEntry
entries =
        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 CreateAssociationBatchRequestEntry
pEntries_
    }

-- | One or more associations.
createAssociationBatch_entries :: Lens.Lens' CreateAssociationBatch (Prelude.NonEmpty CreateAssociationBatchRequestEntry)
createAssociationBatch_entries :: Lens'
  CreateAssociationBatch
  (NonEmpty CreateAssociationBatchRequestEntry)
createAssociationBatch_entries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAssociationBatch' {NonEmpty CreateAssociationBatchRequestEntry
entries :: NonEmpty CreateAssociationBatchRequestEntry
$sel:entries:CreateAssociationBatch' :: CreateAssociationBatch
-> NonEmpty CreateAssociationBatchRequestEntry
entries} -> NonEmpty CreateAssociationBatchRequestEntry
entries) (\s :: CreateAssociationBatch
s@CreateAssociationBatch' {} NonEmpty CreateAssociationBatchRequestEntry
a -> CreateAssociationBatch
s {$sel:entries:CreateAssociationBatch' :: NonEmpty CreateAssociationBatchRequestEntry
entries = NonEmpty CreateAssociationBatchRequestEntry
a} :: CreateAssociationBatch) 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 CreateAssociationBatch where
  type
    AWSResponse CreateAssociationBatch =
      CreateAssociationBatchResponse
  request :: (Service -> Service)
-> CreateAssociationBatch -> Request CreateAssociationBatch
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 CreateAssociationBatch
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateAssociationBatch)))
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 [FailedCreateAssociation]
-> Maybe [AssociationDescription]
-> Int
-> CreateAssociationBatchResponse
CreateAssociationBatchResponse'
            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
"Failed" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"Successful" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 CreateAssociationBatch where
  hashWithSalt :: Int -> CreateAssociationBatch -> Int
hashWithSalt Int
_salt CreateAssociationBatch' {NonEmpty CreateAssociationBatchRequestEntry
entries :: NonEmpty CreateAssociationBatchRequestEntry
$sel:entries:CreateAssociationBatch' :: CreateAssociationBatch
-> NonEmpty CreateAssociationBatchRequestEntry
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty CreateAssociationBatchRequestEntry
entries

instance Prelude.NFData CreateAssociationBatch where
  rnf :: CreateAssociationBatch -> ()
rnf CreateAssociationBatch' {NonEmpty CreateAssociationBatchRequestEntry
entries :: NonEmpty CreateAssociationBatchRequestEntry
$sel:entries:CreateAssociationBatch' :: CreateAssociationBatch
-> NonEmpty CreateAssociationBatchRequestEntry
..} = forall a. NFData a => a -> ()
Prelude.rnf NonEmpty CreateAssociationBatchRequestEntry
entries

instance Data.ToHeaders CreateAssociationBatch where
  toHeaders :: CreateAssociationBatch -> 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
"AmazonSSM.CreateAssociationBatch" ::
                          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 CreateAssociationBatch where
  toJSON :: CreateAssociationBatch -> Value
toJSON CreateAssociationBatch' {NonEmpty CreateAssociationBatchRequestEntry
entries :: NonEmpty CreateAssociationBatchRequestEntry
$sel:entries:CreateAssociationBatch' :: CreateAssociationBatch
-> NonEmpty CreateAssociationBatchRequestEntry
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Entries" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty CreateAssociationBatchRequestEntry
entries)]
      )

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

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

-- | /See:/ 'newCreateAssociationBatchResponse' smart constructor.
data CreateAssociationBatchResponse = CreateAssociationBatchResponse'
  { -- | Information about the associations that failed.
    CreateAssociationBatchResponse -> Maybe [FailedCreateAssociation]
failed :: Prelude.Maybe [FailedCreateAssociation],
    -- | Information about the associations that succeeded.
    CreateAssociationBatchResponse -> Maybe [AssociationDescription]
successful :: Prelude.Maybe [AssociationDescription],
    -- | The response's http status code.
    CreateAssociationBatchResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateAssociationBatchResponse
-> CreateAssociationBatchResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAssociationBatchResponse
-> CreateAssociationBatchResponse -> Bool
$c/= :: CreateAssociationBatchResponse
-> CreateAssociationBatchResponse -> Bool
== :: CreateAssociationBatchResponse
-> CreateAssociationBatchResponse -> Bool
$c== :: CreateAssociationBatchResponse
-> CreateAssociationBatchResponse -> Bool
Prelude.Eq, Int -> CreateAssociationBatchResponse -> ShowS
[CreateAssociationBatchResponse] -> ShowS
CreateAssociationBatchResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAssociationBatchResponse] -> ShowS
$cshowList :: [CreateAssociationBatchResponse] -> ShowS
show :: CreateAssociationBatchResponse -> String
$cshow :: CreateAssociationBatchResponse -> String
showsPrec :: Int -> CreateAssociationBatchResponse -> ShowS
$cshowsPrec :: Int -> CreateAssociationBatchResponse -> ShowS
Prelude.Show, forall x.
Rep CreateAssociationBatchResponse x
-> CreateAssociationBatchResponse
forall x.
CreateAssociationBatchResponse
-> Rep CreateAssociationBatchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateAssociationBatchResponse x
-> CreateAssociationBatchResponse
$cfrom :: forall x.
CreateAssociationBatchResponse
-> Rep CreateAssociationBatchResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateAssociationBatchResponse' 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:
--
-- 'failed', 'createAssociationBatchResponse_failed' - Information about the associations that failed.
--
-- 'successful', 'createAssociationBatchResponse_successful' - Information about the associations that succeeded.
--
-- 'httpStatus', 'createAssociationBatchResponse_httpStatus' - The response's http status code.
newCreateAssociationBatchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateAssociationBatchResponse
newCreateAssociationBatchResponse :: Int -> CreateAssociationBatchResponse
newCreateAssociationBatchResponse Int
pHttpStatus_ =
  CreateAssociationBatchResponse'
    { $sel:failed:CreateAssociationBatchResponse' :: Maybe [FailedCreateAssociation]
failed =
        forall a. Maybe a
Prelude.Nothing,
      $sel:successful:CreateAssociationBatchResponse' :: Maybe [AssociationDescription]
successful = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateAssociationBatchResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the associations that failed.
createAssociationBatchResponse_failed :: Lens.Lens' CreateAssociationBatchResponse (Prelude.Maybe [FailedCreateAssociation])
createAssociationBatchResponse_failed :: Lens'
  CreateAssociationBatchResponse (Maybe [FailedCreateAssociation])
createAssociationBatchResponse_failed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAssociationBatchResponse' {Maybe [FailedCreateAssociation]
failed :: Maybe [FailedCreateAssociation]
$sel:failed:CreateAssociationBatchResponse' :: CreateAssociationBatchResponse -> Maybe [FailedCreateAssociation]
failed} -> Maybe [FailedCreateAssociation]
failed) (\s :: CreateAssociationBatchResponse
s@CreateAssociationBatchResponse' {} Maybe [FailedCreateAssociation]
a -> CreateAssociationBatchResponse
s {$sel:failed:CreateAssociationBatchResponse' :: Maybe [FailedCreateAssociation]
failed = Maybe [FailedCreateAssociation]
a} :: CreateAssociationBatchResponse) 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

-- | Information about the associations that succeeded.
createAssociationBatchResponse_successful :: Lens.Lens' CreateAssociationBatchResponse (Prelude.Maybe [AssociationDescription])
createAssociationBatchResponse_successful :: Lens'
  CreateAssociationBatchResponse (Maybe [AssociationDescription])
createAssociationBatchResponse_successful = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAssociationBatchResponse' {Maybe [AssociationDescription]
successful :: Maybe [AssociationDescription]
$sel:successful:CreateAssociationBatchResponse' :: CreateAssociationBatchResponse -> Maybe [AssociationDescription]
successful} -> Maybe [AssociationDescription]
successful) (\s :: CreateAssociationBatchResponse
s@CreateAssociationBatchResponse' {} Maybe [AssociationDescription]
a -> CreateAssociationBatchResponse
s {$sel:successful:CreateAssociationBatchResponse' :: Maybe [AssociationDescription]
successful = Maybe [AssociationDescription]
a} :: CreateAssociationBatchResponse) 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 response's http status code.
createAssociationBatchResponse_httpStatus :: Lens.Lens' CreateAssociationBatchResponse Prelude.Int
createAssociationBatchResponse_httpStatus :: Lens' CreateAssociationBatchResponse Int
createAssociationBatchResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAssociationBatchResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateAssociationBatchResponse' :: CreateAssociationBatchResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateAssociationBatchResponse
s@CreateAssociationBatchResponse' {} Int
a -> CreateAssociationBatchResponse
s {$sel:httpStatus:CreateAssociationBatchResponse' :: Int
httpStatus = Int
a} :: CreateAssociationBatchResponse)

instance
  Prelude.NFData
    CreateAssociationBatchResponse
  where
  rnf :: CreateAssociationBatchResponse -> ()
rnf CreateAssociationBatchResponse' {Int
Maybe [FailedCreateAssociation]
Maybe [AssociationDescription]
httpStatus :: Int
successful :: Maybe [AssociationDescription]
failed :: Maybe [FailedCreateAssociation]
$sel:httpStatus:CreateAssociationBatchResponse' :: CreateAssociationBatchResponse -> Int
$sel:successful:CreateAssociationBatchResponse' :: CreateAssociationBatchResponse -> Maybe [AssociationDescription]
$sel:failed:CreateAssociationBatchResponse' :: CreateAssociationBatchResponse -> Maybe [FailedCreateAssociation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [FailedCreateAssociation]
failed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [AssociationDescription]
successful
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus