{-# 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.DescribeAssociation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the association for the specified target or managed node. If
-- you created the association by using the @Targets@ parameter, then you
-- must retrieve the association by using the association ID.
module Amazonka.SSM.DescribeAssociation
  ( -- * Creating a Request
    DescribeAssociation (..),
    newDescribeAssociation,

    -- * Request Lenses
    describeAssociation_associationId,
    describeAssociation_associationVersion,
    describeAssociation_instanceId,
    describeAssociation_name,

    -- * Destructuring the Response
    DescribeAssociationResponse (..),
    newDescribeAssociationResponse,

    -- * Response Lenses
    describeAssociationResponse_associationDescription,
    describeAssociationResponse_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:/ 'newDescribeAssociation' smart constructor.
data DescribeAssociation = DescribeAssociation'
  { -- | The association ID for which you want information.
    DescribeAssociation -> Maybe Text
associationId :: Prelude.Maybe Prelude.Text,
    -- | Specify the association version to retrieve. To view the latest version,
    -- either specify @$LATEST@ for this parameter, or omit this parameter. To
    -- view a list of all associations for a managed node, use
    -- ListAssociations. To get a list of versions for a specific association,
    -- use ListAssociationVersions.
    DescribeAssociation -> Maybe Text
associationVersion :: Prelude.Maybe Prelude.Text,
    -- | The managed node ID.
    DescribeAssociation -> Maybe Text
instanceId :: Prelude.Maybe Prelude.Text,
    -- | The name of the SSM document.
    DescribeAssociation -> Maybe Text
name :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeAssociation -> DescribeAssociation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAssociation -> DescribeAssociation -> Bool
$c/= :: DescribeAssociation -> DescribeAssociation -> Bool
== :: DescribeAssociation -> DescribeAssociation -> Bool
$c== :: DescribeAssociation -> DescribeAssociation -> Bool
Prelude.Eq, ReadPrec [DescribeAssociation]
ReadPrec DescribeAssociation
Int -> ReadS DescribeAssociation
ReadS [DescribeAssociation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAssociation]
$creadListPrec :: ReadPrec [DescribeAssociation]
readPrec :: ReadPrec DescribeAssociation
$creadPrec :: ReadPrec DescribeAssociation
readList :: ReadS [DescribeAssociation]
$creadList :: ReadS [DescribeAssociation]
readsPrec :: Int -> ReadS DescribeAssociation
$creadsPrec :: Int -> ReadS DescribeAssociation
Prelude.Read, Int -> DescribeAssociation -> ShowS
[DescribeAssociation] -> ShowS
DescribeAssociation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAssociation] -> ShowS
$cshowList :: [DescribeAssociation] -> ShowS
show :: DescribeAssociation -> String
$cshow :: DescribeAssociation -> String
showsPrec :: Int -> DescribeAssociation -> ShowS
$cshowsPrec :: Int -> DescribeAssociation -> ShowS
Prelude.Show, forall x. Rep DescribeAssociation x -> DescribeAssociation
forall x. DescribeAssociation -> Rep DescribeAssociation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAssociation x -> DescribeAssociation
$cfrom :: forall x. DescribeAssociation -> Rep DescribeAssociation x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAssociation' 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:
--
-- 'associationId', 'describeAssociation_associationId' - The association ID for which you want information.
--
-- 'associationVersion', 'describeAssociation_associationVersion' - Specify the association version to retrieve. To view the latest version,
-- either specify @$LATEST@ for this parameter, or omit this parameter. To
-- view a list of all associations for a managed node, use
-- ListAssociations. To get a list of versions for a specific association,
-- use ListAssociationVersions.
--
-- 'instanceId', 'describeAssociation_instanceId' - The managed node ID.
--
-- 'name', 'describeAssociation_name' - The name of the SSM document.
newDescribeAssociation ::
  DescribeAssociation
newDescribeAssociation :: DescribeAssociation
newDescribeAssociation =
  DescribeAssociation'
    { $sel:associationId:DescribeAssociation' :: Maybe Text
associationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:associationVersion:DescribeAssociation' :: Maybe Text
associationVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:DescribeAssociation' :: Maybe Text
instanceId = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DescribeAssociation' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing
    }

-- | The association ID for which you want information.
describeAssociation_associationId :: Lens.Lens' DescribeAssociation (Prelude.Maybe Prelude.Text)
describeAssociation_associationId :: Lens' DescribeAssociation (Maybe Text)
describeAssociation_associationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssociation' {Maybe Text
associationId :: Maybe Text
$sel:associationId:DescribeAssociation' :: DescribeAssociation -> Maybe Text
associationId} -> Maybe Text
associationId) (\s :: DescribeAssociation
s@DescribeAssociation' {} Maybe Text
a -> DescribeAssociation
s {$sel:associationId:DescribeAssociation' :: Maybe Text
associationId = Maybe Text
a} :: DescribeAssociation)

-- | Specify the association version to retrieve. To view the latest version,
-- either specify @$LATEST@ for this parameter, or omit this parameter. To
-- view a list of all associations for a managed node, use
-- ListAssociations. To get a list of versions for a specific association,
-- use ListAssociationVersions.
describeAssociation_associationVersion :: Lens.Lens' DescribeAssociation (Prelude.Maybe Prelude.Text)
describeAssociation_associationVersion :: Lens' DescribeAssociation (Maybe Text)
describeAssociation_associationVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssociation' {Maybe Text
associationVersion :: Maybe Text
$sel:associationVersion:DescribeAssociation' :: DescribeAssociation -> Maybe Text
associationVersion} -> Maybe Text
associationVersion) (\s :: DescribeAssociation
s@DescribeAssociation' {} Maybe Text
a -> DescribeAssociation
s {$sel:associationVersion:DescribeAssociation' :: Maybe Text
associationVersion = Maybe Text
a} :: DescribeAssociation)

-- | The managed node ID.
describeAssociation_instanceId :: Lens.Lens' DescribeAssociation (Prelude.Maybe Prelude.Text)
describeAssociation_instanceId :: Lens' DescribeAssociation (Maybe Text)
describeAssociation_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssociation' {Maybe Text
instanceId :: Maybe Text
$sel:instanceId:DescribeAssociation' :: DescribeAssociation -> Maybe Text
instanceId} -> Maybe Text
instanceId) (\s :: DescribeAssociation
s@DescribeAssociation' {} Maybe Text
a -> DescribeAssociation
s {$sel:instanceId:DescribeAssociation' :: Maybe Text
instanceId = Maybe Text
a} :: DescribeAssociation)

-- | The name of the SSM document.
describeAssociation_name :: Lens.Lens' DescribeAssociation (Prelude.Maybe Prelude.Text)
describeAssociation_name :: Lens' DescribeAssociation (Maybe Text)
describeAssociation_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssociation' {Maybe Text
name :: Maybe Text
$sel:name:DescribeAssociation' :: DescribeAssociation -> Maybe Text
name} -> Maybe Text
name) (\s :: DescribeAssociation
s@DescribeAssociation' {} Maybe Text
a -> DescribeAssociation
s {$sel:name:DescribeAssociation' :: Maybe Text
name = Maybe Text
a} :: DescribeAssociation)

instance Core.AWSRequest DescribeAssociation where
  type
    AWSResponse DescribeAssociation =
      DescribeAssociationResponse
  request :: (Service -> Service)
-> DescribeAssociation -> Request DescribeAssociation
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 DescribeAssociation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeAssociation)))
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 AssociationDescription -> Int -> DescribeAssociationResponse
DescribeAssociationResponse'
            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
"AssociationDescription")
            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 DescribeAssociation where
  hashWithSalt :: Int -> DescribeAssociation -> Int
hashWithSalt Int
_salt DescribeAssociation' {Maybe Text
name :: Maybe Text
instanceId :: Maybe Text
associationVersion :: Maybe Text
associationId :: Maybe Text
$sel:name:DescribeAssociation' :: DescribeAssociation -> Maybe Text
$sel:instanceId:DescribeAssociation' :: DescribeAssociation -> Maybe Text
$sel:associationVersion:DescribeAssociation' :: DescribeAssociation -> Maybe Text
$sel:associationId:DescribeAssociation' :: DescribeAssociation -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
associationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
associationVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name

instance Prelude.NFData DescribeAssociation where
  rnf :: DescribeAssociation -> ()
rnf DescribeAssociation' {Maybe Text
name :: Maybe Text
instanceId :: Maybe Text
associationVersion :: Maybe Text
associationId :: Maybe Text
$sel:name:DescribeAssociation' :: DescribeAssociation -> Maybe Text
$sel:instanceId:DescribeAssociation' :: DescribeAssociation -> Maybe Text
$sel:associationVersion:DescribeAssociation' :: DescribeAssociation -> Maybe Text
$sel:associationId:DescribeAssociation' :: DescribeAssociation -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
associationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
associationVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name

instance Data.ToHeaders DescribeAssociation where
  toHeaders :: DescribeAssociation -> 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.DescribeAssociation" ::
                          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 DescribeAssociation where
  toJSON :: DescribeAssociation -> Value
toJSON DescribeAssociation' {Maybe Text
name :: Maybe Text
instanceId :: Maybe Text
associationVersion :: Maybe Text
associationId :: Maybe Text
$sel:name:DescribeAssociation' :: DescribeAssociation -> Maybe Text
$sel:instanceId:DescribeAssociation' :: DescribeAssociation -> Maybe Text
$sel:associationVersion:DescribeAssociation' :: DescribeAssociation -> Maybe Text
$sel:associationId:DescribeAssociation' :: DescribeAssociation -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AssociationId" 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
associationId,
            (Key
"AssociationVersion" 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
associationVersion,
            (Key
"InstanceId" 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
instanceId,
            (Key
"Name" 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
name
          ]
      )

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

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

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

-- |
-- Create a value of 'DescribeAssociationResponse' 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:
--
-- 'associationDescription', 'describeAssociationResponse_associationDescription' - Information about the association.
--
-- 'httpStatus', 'describeAssociationResponse_httpStatus' - The response's http status code.
newDescribeAssociationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeAssociationResponse
newDescribeAssociationResponse :: Int -> DescribeAssociationResponse
newDescribeAssociationResponse Int
pHttpStatus_ =
  DescribeAssociationResponse'
    { $sel:associationDescription:DescribeAssociationResponse' :: Maybe AssociationDescription
associationDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeAssociationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the association.
describeAssociationResponse_associationDescription :: Lens.Lens' DescribeAssociationResponse (Prelude.Maybe AssociationDescription)
describeAssociationResponse_associationDescription :: Lens' DescribeAssociationResponse (Maybe AssociationDescription)
describeAssociationResponse_associationDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssociationResponse' {Maybe AssociationDescription
associationDescription :: Maybe AssociationDescription
$sel:associationDescription:DescribeAssociationResponse' :: DescribeAssociationResponse -> Maybe AssociationDescription
associationDescription} -> Maybe AssociationDescription
associationDescription) (\s :: DescribeAssociationResponse
s@DescribeAssociationResponse' {} Maybe AssociationDescription
a -> DescribeAssociationResponse
s {$sel:associationDescription:DescribeAssociationResponse' :: Maybe AssociationDescription
associationDescription = Maybe AssociationDescription
a} :: DescribeAssociationResponse)

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

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