{-# 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.Route53Resolver.AssociateResolverQueryLogConfig
-- 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 an Amazon VPC with a specified query logging configuration.
-- Route 53 Resolver logs DNS queries that originate in all of the Amazon
-- VPCs that are associated with a specified query logging configuration.
-- To associate more than one VPC with a configuration, submit one
-- @AssociateResolverQueryLogConfig@ request for each VPC.
--
-- The VPCs that you associate with a query logging configuration must be
-- in the same Region as the configuration.
--
-- To remove a VPC from a query logging configuration, see
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_route53resolver_DisassociateResolverQueryLogConfig.html DisassociateResolverQueryLogConfig>.
module Amazonka.Route53Resolver.AssociateResolverQueryLogConfig
  ( -- * Creating a Request
    AssociateResolverQueryLogConfig (..),
    newAssociateResolverQueryLogConfig,

    -- * Request Lenses
    associateResolverQueryLogConfig_resolverQueryLogConfigId,
    associateResolverQueryLogConfig_resourceId,

    -- * Destructuring the Response
    AssociateResolverQueryLogConfigResponse (..),
    newAssociateResolverQueryLogConfigResponse,

    -- * Response Lenses
    associateResolverQueryLogConfigResponse_resolverQueryLogConfigAssociation,
    associateResolverQueryLogConfigResponse_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.Route53Resolver.Types

-- | /See:/ 'newAssociateResolverQueryLogConfig' smart constructor.
data AssociateResolverQueryLogConfig = AssociateResolverQueryLogConfig'
  { -- | The ID of the query logging configuration that you want to associate a
    -- VPC with.
    AssociateResolverQueryLogConfig -> Text
resolverQueryLogConfigId :: Prelude.Text,
    -- | The ID of an Amazon VPC that you want this query logging configuration
    -- to log queries for.
    --
    -- The VPCs and the query logging configuration must be in the same Region.
    AssociateResolverQueryLogConfig -> Text
resourceId :: Prelude.Text
  }
  deriving (AssociateResolverQueryLogConfig
-> AssociateResolverQueryLogConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateResolverQueryLogConfig
-> AssociateResolverQueryLogConfig -> Bool
$c/= :: AssociateResolverQueryLogConfig
-> AssociateResolverQueryLogConfig -> Bool
== :: AssociateResolverQueryLogConfig
-> AssociateResolverQueryLogConfig -> Bool
$c== :: AssociateResolverQueryLogConfig
-> AssociateResolverQueryLogConfig -> Bool
Prelude.Eq, ReadPrec [AssociateResolverQueryLogConfig]
ReadPrec AssociateResolverQueryLogConfig
Int -> ReadS AssociateResolverQueryLogConfig
ReadS [AssociateResolverQueryLogConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateResolverQueryLogConfig]
$creadListPrec :: ReadPrec [AssociateResolverQueryLogConfig]
readPrec :: ReadPrec AssociateResolverQueryLogConfig
$creadPrec :: ReadPrec AssociateResolverQueryLogConfig
readList :: ReadS [AssociateResolverQueryLogConfig]
$creadList :: ReadS [AssociateResolverQueryLogConfig]
readsPrec :: Int -> ReadS AssociateResolverQueryLogConfig
$creadsPrec :: Int -> ReadS AssociateResolverQueryLogConfig
Prelude.Read, Int -> AssociateResolverQueryLogConfig -> ShowS
[AssociateResolverQueryLogConfig] -> ShowS
AssociateResolverQueryLogConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateResolverQueryLogConfig] -> ShowS
$cshowList :: [AssociateResolverQueryLogConfig] -> ShowS
show :: AssociateResolverQueryLogConfig -> String
$cshow :: AssociateResolverQueryLogConfig -> String
showsPrec :: Int -> AssociateResolverQueryLogConfig -> ShowS
$cshowsPrec :: Int -> AssociateResolverQueryLogConfig -> ShowS
Prelude.Show, forall x.
Rep AssociateResolverQueryLogConfig x
-> AssociateResolverQueryLogConfig
forall x.
AssociateResolverQueryLogConfig
-> Rep AssociateResolverQueryLogConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateResolverQueryLogConfig x
-> AssociateResolverQueryLogConfig
$cfrom :: forall x.
AssociateResolverQueryLogConfig
-> Rep AssociateResolverQueryLogConfig x
Prelude.Generic)

-- |
-- Create a value of 'AssociateResolverQueryLogConfig' 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:
--
-- 'resolverQueryLogConfigId', 'associateResolverQueryLogConfig_resolverQueryLogConfigId' - The ID of the query logging configuration that you want to associate a
-- VPC with.
--
-- 'resourceId', 'associateResolverQueryLogConfig_resourceId' - The ID of an Amazon VPC that you want this query logging configuration
-- to log queries for.
--
-- The VPCs and the query logging configuration must be in the same Region.
newAssociateResolverQueryLogConfig ::
  -- | 'resolverQueryLogConfigId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  AssociateResolverQueryLogConfig
newAssociateResolverQueryLogConfig :: Text -> Text -> AssociateResolverQueryLogConfig
newAssociateResolverQueryLogConfig
  Text
pResolverQueryLogConfigId_
  Text
pResourceId_ =
    AssociateResolverQueryLogConfig'
      { $sel:resolverQueryLogConfigId:AssociateResolverQueryLogConfig' :: Text
resolverQueryLogConfigId =
          Text
pResolverQueryLogConfigId_,
        $sel:resourceId:AssociateResolverQueryLogConfig' :: Text
resourceId = Text
pResourceId_
      }

-- | The ID of the query logging configuration that you want to associate a
-- VPC with.
associateResolverQueryLogConfig_resolverQueryLogConfigId :: Lens.Lens' AssociateResolverQueryLogConfig Prelude.Text
associateResolverQueryLogConfig_resolverQueryLogConfigId :: Lens' AssociateResolverQueryLogConfig Text
associateResolverQueryLogConfig_resolverQueryLogConfigId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateResolverQueryLogConfig' {Text
resolverQueryLogConfigId :: Text
$sel:resolverQueryLogConfigId:AssociateResolverQueryLogConfig' :: AssociateResolverQueryLogConfig -> Text
resolverQueryLogConfigId} -> Text
resolverQueryLogConfigId) (\s :: AssociateResolverQueryLogConfig
s@AssociateResolverQueryLogConfig' {} Text
a -> AssociateResolverQueryLogConfig
s {$sel:resolverQueryLogConfigId:AssociateResolverQueryLogConfig' :: Text
resolverQueryLogConfigId = Text
a} :: AssociateResolverQueryLogConfig)

-- | The ID of an Amazon VPC that you want this query logging configuration
-- to log queries for.
--
-- The VPCs and the query logging configuration must be in the same Region.
associateResolverQueryLogConfig_resourceId :: Lens.Lens' AssociateResolverQueryLogConfig Prelude.Text
associateResolverQueryLogConfig_resourceId :: Lens' AssociateResolverQueryLogConfig Text
associateResolverQueryLogConfig_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateResolverQueryLogConfig' {Text
resourceId :: Text
$sel:resourceId:AssociateResolverQueryLogConfig' :: AssociateResolverQueryLogConfig -> Text
resourceId} -> Text
resourceId) (\s :: AssociateResolverQueryLogConfig
s@AssociateResolverQueryLogConfig' {} Text
a -> AssociateResolverQueryLogConfig
s {$sel:resourceId:AssociateResolverQueryLogConfig' :: Text
resourceId = Text
a} :: AssociateResolverQueryLogConfig)

instance
  Core.AWSRequest
    AssociateResolverQueryLogConfig
  where
  type
    AWSResponse AssociateResolverQueryLogConfig =
      AssociateResolverQueryLogConfigResponse
  request :: (Service -> Service)
-> AssociateResolverQueryLogConfig
-> Request AssociateResolverQueryLogConfig
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 AssociateResolverQueryLogConfig
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse AssociateResolverQueryLogConfig)))
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 ResolverQueryLogConfigAssociation
-> Int -> AssociateResolverQueryLogConfigResponse
AssociateResolverQueryLogConfigResponse'
            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
"ResolverQueryLogConfigAssociation")
            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
    AssociateResolverQueryLogConfig
  where
  hashWithSalt :: Int -> AssociateResolverQueryLogConfig -> Int
hashWithSalt
    Int
_salt
    AssociateResolverQueryLogConfig' {Text
resourceId :: Text
resolverQueryLogConfigId :: Text
$sel:resourceId:AssociateResolverQueryLogConfig' :: AssociateResolverQueryLogConfig -> Text
$sel:resolverQueryLogConfigId:AssociateResolverQueryLogConfig' :: AssociateResolverQueryLogConfig -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resolverQueryLogConfigId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId

instance
  Prelude.NFData
    AssociateResolverQueryLogConfig
  where
  rnf :: AssociateResolverQueryLogConfig -> ()
rnf AssociateResolverQueryLogConfig' {Text
resourceId :: Text
resolverQueryLogConfigId :: Text
$sel:resourceId:AssociateResolverQueryLogConfig' :: AssociateResolverQueryLogConfig -> Text
$sel:resolverQueryLogConfigId:AssociateResolverQueryLogConfig' :: AssociateResolverQueryLogConfig -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
resolverQueryLogConfigId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId

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

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

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

-- | /See:/ 'newAssociateResolverQueryLogConfigResponse' smart constructor.
data AssociateResolverQueryLogConfigResponse = AssociateResolverQueryLogConfigResponse'
  { -- | A complex type that contains settings for a specified association
    -- between an Amazon VPC and a query logging configuration.
    AssociateResolverQueryLogConfigResponse
-> Maybe ResolverQueryLogConfigAssociation
resolverQueryLogConfigAssociation :: Prelude.Maybe ResolverQueryLogConfigAssociation,
    -- | The response's http status code.
    AssociateResolverQueryLogConfigResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AssociateResolverQueryLogConfigResponse
-> AssociateResolverQueryLogConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateResolverQueryLogConfigResponse
-> AssociateResolverQueryLogConfigResponse -> Bool
$c/= :: AssociateResolverQueryLogConfigResponse
-> AssociateResolverQueryLogConfigResponse -> Bool
== :: AssociateResolverQueryLogConfigResponse
-> AssociateResolverQueryLogConfigResponse -> Bool
$c== :: AssociateResolverQueryLogConfigResponse
-> AssociateResolverQueryLogConfigResponse -> Bool
Prelude.Eq, ReadPrec [AssociateResolverQueryLogConfigResponse]
ReadPrec AssociateResolverQueryLogConfigResponse
Int -> ReadS AssociateResolverQueryLogConfigResponse
ReadS [AssociateResolverQueryLogConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateResolverQueryLogConfigResponse]
$creadListPrec :: ReadPrec [AssociateResolverQueryLogConfigResponse]
readPrec :: ReadPrec AssociateResolverQueryLogConfigResponse
$creadPrec :: ReadPrec AssociateResolverQueryLogConfigResponse
readList :: ReadS [AssociateResolverQueryLogConfigResponse]
$creadList :: ReadS [AssociateResolverQueryLogConfigResponse]
readsPrec :: Int -> ReadS AssociateResolverQueryLogConfigResponse
$creadsPrec :: Int -> ReadS AssociateResolverQueryLogConfigResponse
Prelude.Read, Int -> AssociateResolverQueryLogConfigResponse -> ShowS
[AssociateResolverQueryLogConfigResponse] -> ShowS
AssociateResolverQueryLogConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateResolverQueryLogConfigResponse] -> ShowS
$cshowList :: [AssociateResolverQueryLogConfigResponse] -> ShowS
show :: AssociateResolverQueryLogConfigResponse -> String
$cshow :: AssociateResolverQueryLogConfigResponse -> String
showsPrec :: Int -> AssociateResolverQueryLogConfigResponse -> ShowS
$cshowsPrec :: Int -> AssociateResolverQueryLogConfigResponse -> ShowS
Prelude.Show, forall x.
Rep AssociateResolverQueryLogConfigResponse x
-> AssociateResolverQueryLogConfigResponse
forall x.
AssociateResolverQueryLogConfigResponse
-> Rep AssociateResolverQueryLogConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateResolverQueryLogConfigResponse x
-> AssociateResolverQueryLogConfigResponse
$cfrom :: forall x.
AssociateResolverQueryLogConfigResponse
-> Rep AssociateResolverQueryLogConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'AssociateResolverQueryLogConfigResponse' 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:
--
-- 'resolverQueryLogConfigAssociation', 'associateResolverQueryLogConfigResponse_resolverQueryLogConfigAssociation' - A complex type that contains settings for a specified association
-- between an Amazon VPC and a query logging configuration.
--
-- 'httpStatus', 'associateResolverQueryLogConfigResponse_httpStatus' - The response's http status code.
newAssociateResolverQueryLogConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateResolverQueryLogConfigResponse
newAssociateResolverQueryLogConfigResponse :: Int -> AssociateResolverQueryLogConfigResponse
newAssociateResolverQueryLogConfigResponse
  Int
pHttpStatus_ =
    AssociateResolverQueryLogConfigResponse'
      { $sel:resolverQueryLogConfigAssociation:AssociateResolverQueryLogConfigResponse' :: Maybe ResolverQueryLogConfigAssociation
resolverQueryLogConfigAssociation =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:AssociateResolverQueryLogConfigResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | A complex type that contains settings for a specified association
-- between an Amazon VPC and a query logging configuration.
associateResolverQueryLogConfigResponse_resolverQueryLogConfigAssociation :: Lens.Lens' AssociateResolverQueryLogConfigResponse (Prelude.Maybe ResolverQueryLogConfigAssociation)
associateResolverQueryLogConfigResponse_resolverQueryLogConfigAssociation :: Lens'
  AssociateResolverQueryLogConfigResponse
  (Maybe ResolverQueryLogConfigAssociation)
associateResolverQueryLogConfigResponse_resolverQueryLogConfigAssociation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateResolverQueryLogConfigResponse' {Maybe ResolverQueryLogConfigAssociation
resolverQueryLogConfigAssociation :: Maybe ResolverQueryLogConfigAssociation
$sel:resolverQueryLogConfigAssociation:AssociateResolverQueryLogConfigResponse' :: AssociateResolverQueryLogConfigResponse
-> Maybe ResolverQueryLogConfigAssociation
resolverQueryLogConfigAssociation} -> Maybe ResolverQueryLogConfigAssociation
resolverQueryLogConfigAssociation) (\s :: AssociateResolverQueryLogConfigResponse
s@AssociateResolverQueryLogConfigResponse' {} Maybe ResolverQueryLogConfigAssociation
a -> AssociateResolverQueryLogConfigResponse
s {$sel:resolverQueryLogConfigAssociation:AssociateResolverQueryLogConfigResponse' :: Maybe ResolverQueryLogConfigAssociation
resolverQueryLogConfigAssociation = Maybe ResolverQueryLogConfigAssociation
a} :: AssociateResolverQueryLogConfigResponse)

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

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