{-# 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.CloudWatchLogs.AssociateKmsKey
-- 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 KMS key with the specified log group.
--
-- Associating a KMS key with a log group overrides any existing
-- associations between the log group and a KMS key. After a KMS key is
-- associated with a log group, all newly ingested data for the log group
-- is encrypted using the KMS key. This association is stored as long as
-- the data encrypted with the KMS keyis still within CloudWatch Logs. This
-- enables CloudWatch Logs to decrypt this data whenever it is requested.
--
-- CloudWatch Logs supports only symmetric KMS keys. Do not use an
-- associate an asymmetric KMS key with your log group. For more
-- information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/symmetric-asymmetric.html Using Symmetric and Asymmetric Keys>.
--
-- It can take up to 5 minutes for this operation to take effect.
--
-- If you attempt to associate a KMS key with a log group but the KMS key
-- does not exist or the KMS key is disabled, you receive an
-- @InvalidParameterException@ error.
module Amazonka.CloudWatchLogs.AssociateKmsKey
  ( -- * Creating a Request
    AssociateKmsKey (..),
    newAssociateKmsKey,

    -- * Request Lenses
    associateKmsKey_logGroupName,
    associateKmsKey_kmsKeyId,

    -- * Destructuring the Response
    AssociateKmsKeyResponse (..),
    newAssociateKmsKeyResponse,
  )
where

import Amazonka.CloudWatchLogs.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:/ 'newAssociateKmsKey' smart constructor.
data AssociateKmsKey = AssociateKmsKey'
  { -- | The name of the log group.
    AssociateKmsKey -> Text
logGroupName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the KMS key to use when encrypting log
    -- data. This must be a symmetric KMS key. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#arn-syntax-kms Amazon Resource Names>
    -- and
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/symmetric-asymmetric.html Using Symmetric and Asymmetric Keys>.
    AssociateKmsKey -> Text
kmsKeyId :: Prelude.Text
  }
  deriving (AssociateKmsKey -> AssociateKmsKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateKmsKey -> AssociateKmsKey -> Bool
$c/= :: AssociateKmsKey -> AssociateKmsKey -> Bool
== :: AssociateKmsKey -> AssociateKmsKey -> Bool
$c== :: AssociateKmsKey -> AssociateKmsKey -> Bool
Prelude.Eq, ReadPrec [AssociateKmsKey]
ReadPrec AssociateKmsKey
Int -> ReadS AssociateKmsKey
ReadS [AssociateKmsKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateKmsKey]
$creadListPrec :: ReadPrec [AssociateKmsKey]
readPrec :: ReadPrec AssociateKmsKey
$creadPrec :: ReadPrec AssociateKmsKey
readList :: ReadS [AssociateKmsKey]
$creadList :: ReadS [AssociateKmsKey]
readsPrec :: Int -> ReadS AssociateKmsKey
$creadsPrec :: Int -> ReadS AssociateKmsKey
Prelude.Read, Int -> AssociateKmsKey -> ShowS
[AssociateKmsKey] -> ShowS
AssociateKmsKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateKmsKey] -> ShowS
$cshowList :: [AssociateKmsKey] -> ShowS
show :: AssociateKmsKey -> String
$cshow :: AssociateKmsKey -> String
showsPrec :: Int -> AssociateKmsKey -> ShowS
$cshowsPrec :: Int -> AssociateKmsKey -> ShowS
Prelude.Show, forall x. Rep AssociateKmsKey x -> AssociateKmsKey
forall x. AssociateKmsKey -> Rep AssociateKmsKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateKmsKey x -> AssociateKmsKey
$cfrom :: forall x. AssociateKmsKey -> Rep AssociateKmsKey x
Prelude.Generic)

-- |
-- Create a value of 'AssociateKmsKey' 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:
--
-- 'logGroupName', 'associateKmsKey_logGroupName' - The name of the log group.
--
-- 'kmsKeyId', 'associateKmsKey_kmsKeyId' - The Amazon Resource Name (ARN) of the KMS key to use when encrypting log
-- data. This must be a symmetric KMS key. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#arn-syntax-kms Amazon Resource Names>
-- and
-- <https://docs.aws.amazon.com/kms/latest/developerguide/symmetric-asymmetric.html Using Symmetric and Asymmetric Keys>.
newAssociateKmsKey ::
  -- | 'logGroupName'
  Prelude.Text ->
  -- | 'kmsKeyId'
  Prelude.Text ->
  AssociateKmsKey
newAssociateKmsKey :: Text -> Text -> AssociateKmsKey
newAssociateKmsKey Text
pLogGroupName_ Text
pKmsKeyId_ =
  AssociateKmsKey'
    { $sel:logGroupName:AssociateKmsKey' :: Text
logGroupName = Text
pLogGroupName_,
      $sel:kmsKeyId:AssociateKmsKey' :: Text
kmsKeyId = Text
pKmsKeyId_
    }

-- | The name of the log group.
associateKmsKey_logGroupName :: Lens.Lens' AssociateKmsKey Prelude.Text
associateKmsKey_logGroupName :: Lens' AssociateKmsKey Text
associateKmsKey_logGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateKmsKey' {Text
logGroupName :: Text
$sel:logGroupName:AssociateKmsKey' :: AssociateKmsKey -> Text
logGroupName} -> Text
logGroupName) (\s :: AssociateKmsKey
s@AssociateKmsKey' {} Text
a -> AssociateKmsKey
s {$sel:logGroupName:AssociateKmsKey' :: Text
logGroupName = Text
a} :: AssociateKmsKey)

-- | The Amazon Resource Name (ARN) of the KMS key to use when encrypting log
-- data. This must be a symmetric KMS key. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#arn-syntax-kms Amazon Resource Names>
-- and
-- <https://docs.aws.amazon.com/kms/latest/developerguide/symmetric-asymmetric.html Using Symmetric and Asymmetric Keys>.
associateKmsKey_kmsKeyId :: Lens.Lens' AssociateKmsKey Prelude.Text
associateKmsKey_kmsKeyId :: Lens' AssociateKmsKey Text
associateKmsKey_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateKmsKey' {Text
kmsKeyId :: Text
$sel:kmsKeyId:AssociateKmsKey' :: AssociateKmsKey -> Text
kmsKeyId} -> Text
kmsKeyId) (\s :: AssociateKmsKey
s@AssociateKmsKey' {} Text
a -> AssociateKmsKey
s {$sel:kmsKeyId:AssociateKmsKey' :: Text
kmsKeyId = Text
a} :: AssociateKmsKey)

instance Core.AWSRequest AssociateKmsKey where
  type
    AWSResponse AssociateKmsKey =
      AssociateKmsKeyResponse
  request :: (Service -> Service) -> AssociateKmsKey -> Request AssociateKmsKey
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 AssociateKmsKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AssociateKmsKey)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull AssociateKmsKeyResponse
AssociateKmsKeyResponse'

instance Prelude.Hashable AssociateKmsKey where
  hashWithSalt :: Int -> AssociateKmsKey -> Int
hashWithSalt Int
_salt AssociateKmsKey' {Text
kmsKeyId :: Text
logGroupName :: Text
$sel:kmsKeyId:AssociateKmsKey' :: AssociateKmsKey -> Text
$sel:logGroupName:AssociateKmsKey' :: AssociateKmsKey -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
logGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
kmsKeyId

instance Prelude.NFData AssociateKmsKey where
  rnf :: AssociateKmsKey -> ()
rnf AssociateKmsKey' {Text
kmsKeyId :: Text
logGroupName :: Text
$sel:kmsKeyId:AssociateKmsKey' :: AssociateKmsKey -> Text
$sel:logGroupName:AssociateKmsKey' :: AssociateKmsKey -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
logGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
kmsKeyId

instance Data.ToHeaders AssociateKmsKey where
  toHeaders :: AssociateKmsKey -> [Header]
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 -> [Header]
Data.=# ( ByteString
"Logs_20140328.AssociateKmsKey" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON AssociateKmsKey where
  toJSON :: AssociateKmsKey -> Value
toJSON AssociateKmsKey' {Text
kmsKeyId :: Text
logGroupName :: Text
$sel:kmsKeyId:AssociateKmsKey' :: AssociateKmsKey -> Text
$sel:logGroupName:AssociateKmsKey' :: AssociateKmsKey -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"logGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
logGroupName),
            forall a. a -> Maybe a
Prelude.Just (Key
"kmsKeyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
kmsKeyId)
          ]
      )

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

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

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

-- |
-- Create a value of 'AssociateKmsKeyResponse' 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.
newAssociateKmsKeyResponse ::
  AssociateKmsKeyResponse
newAssociateKmsKeyResponse :: AssociateKmsKeyResponse
newAssociateKmsKeyResponse = AssociateKmsKeyResponse
AssociateKmsKeyResponse'

instance Prelude.NFData AssociateKmsKeyResponse where
  rnf :: AssociateKmsKeyResponse -> ()
rnf AssociateKmsKeyResponse
_ = ()