{-# 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.Config.PutAggregationAuthorization
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Authorizes the aggregator account and region to collect data from the
-- source account and region.
module Amazonka.Config.PutAggregationAuthorization
  ( -- * Creating a Request
    PutAggregationAuthorization (..),
    newPutAggregationAuthorization,

    -- * Request Lenses
    putAggregationAuthorization_tags,
    putAggregationAuthorization_authorizedAccountId,
    putAggregationAuthorization_authorizedAwsRegion,

    -- * Destructuring the Response
    PutAggregationAuthorizationResponse (..),
    newPutAggregationAuthorizationResponse,

    -- * Response Lenses
    putAggregationAuthorizationResponse_aggregationAuthorization,
    putAggregationAuthorizationResponse_httpStatus,
  )
where

import Amazonka.Config.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:/ 'newPutAggregationAuthorization' smart constructor.
data PutAggregationAuthorization = PutAggregationAuthorization'
  { -- | An array of tag object.
    PutAggregationAuthorization -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The 12-digit account ID of the account authorized to aggregate data.
    PutAggregationAuthorization -> Text
authorizedAccountId :: Prelude.Text,
    -- | The region authorized to collect aggregated data.
    PutAggregationAuthorization -> Text
authorizedAwsRegion :: Prelude.Text
  }
  deriving (PutAggregationAuthorization -> PutAggregationAuthorization -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutAggregationAuthorization -> PutAggregationAuthorization -> Bool
$c/= :: PutAggregationAuthorization -> PutAggregationAuthorization -> Bool
== :: PutAggregationAuthorization -> PutAggregationAuthorization -> Bool
$c== :: PutAggregationAuthorization -> PutAggregationAuthorization -> Bool
Prelude.Eq, ReadPrec [PutAggregationAuthorization]
ReadPrec PutAggregationAuthorization
Int -> ReadS PutAggregationAuthorization
ReadS [PutAggregationAuthorization]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutAggregationAuthorization]
$creadListPrec :: ReadPrec [PutAggregationAuthorization]
readPrec :: ReadPrec PutAggregationAuthorization
$creadPrec :: ReadPrec PutAggregationAuthorization
readList :: ReadS [PutAggregationAuthorization]
$creadList :: ReadS [PutAggregationAuthorization]
readsPrec :: Int -> ReadS PutAggregationAuthorization
$creadsPrec :: Int -> ReadS PutAggregationAuthorization
Prelude.Read, Int -> PutAggregationAuthorization -> ShowS
[PutAggregationAuthorization] -> ShowS
PutAggregationAuthorization -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutAggregationAuthorization] -> ShowS
$cshowList :: [PutAggregationAuthorization] -> ShowS
show :: PutAggregationAuthorization -> String
$cshow :: PutAggregationAuthorization -> String
showsPrec :: Int -> PutAggregationAuthorization -> ShowS
$cshowsPrec :: Int -> PutAggregationAuthorization -> ShowS
Prelude.Show, forall x.
Rep PutAggregationAuthorization x -> PutAggregationAuthorization
forall x.
PutAggregationAuthorization -> Rep PutAggregationAuthorization x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutAggregationAuthorization x -> PutAggregationAuthorization
$cfrom :: forall x.
PutAggregationAuthorization -> Rep PutAggregationAuthorization x
Prelude.Generic)

-- |
-- Create a value of 'PutAggregationAuthorization' 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:
--
-- 'tags', 'putAggregationAuthorization_tags' - An array of tag object.
--
-- 'authorizedAccountId', 'putAggregationAuthorization_authorizedAccountId' - The 12-digit account ID of the account authorized to aggregate data.
--
-- 'authorizedAwsRegion', 'putAggregationAuthorization_authorizedAwsRegion' - The region authorized to collect aggregated data.
newPutAggregationAuthorization ::
  -- | 'authorizedAccountId'
  Prelude.Text ->
  -- | 'authorizedAwsRegion'
  Prelude.Text ->
  PutAggregationAuthorization
newPutAggregationAuthorization :: Text -> Text -> PutAggregationAuthorization
newPutAggregationAuthorization
  Text
pAuthorizedAccountId_
  Text
pAuthorizedAwsRegion_ =
    PutAggregationAuthorization'
      { $sel:tags:PutAggregationAuthorization' :: Maybe [Tag]
tags =
          forall a. Maybe a
Prelude.Nothing,
        $sel:authorizedAccountId:PutAggregationAuthorization' :: Text
authorizedAccountId = Text
pAuthorizedAccountId_,
        $sel:authorizedAwsRegion:PutAggregationAuthorization' :: Text
authorizedAwsRegion = Text
pAuthorizedAwsRegion_
      }

-- | An array of tag object.
putAggregationAuthorization_tags :: Lens.Lens' PutAggregationAuthorization (Prelude.Maybe [Tag])
putAggregationAuthorization_tags :: Lens' PutAggregationAuthorization (Maybe [Tag])
putAggregationAuthorization_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAggregationAuthorization' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:PutAggregationAuthorization' :: PutAggregationAuthorization -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: PutAggregationAuthorization
s@PutAggregationAuthorization' {} Maybe [Tag]
a -> PutAggregationAuthorization
s {$sel:tags:PutAggregationAuthorization' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: PutAggregationAuthorization) 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 12-digit account ID of the account authorized to aggregate data.
putAggregationAuthorization_authorizedAccountId :: Lens.Lens' PutAggregationAuthorization Prelude.Text
putAggregationAuthorization_authorizedAccountId :: Lens' PutAggregationAuthorization Text
putAggregationAuthorization_authorizedAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAggregationAuthorization' {Text
authorizedAccountId :: Text
$sel:authorizedAccountId:PutAggregationAuthorization' :: PutAggregationAuthorization -> Text
authorizedAccountId} -> Text
authorizedAccountId) (\s :: PutAggregationAuthorization
s@PutAggregationAuthorization' {} Text
a -> PutAggregationAuthorization
s {$sel:authorizedAccountId:PutAggregationAuthorization' :: Text
authorizedAccountId = Text
a} :: PutAggregationAuthorization)

-- | The region authorized to collect aggregated data.
putAggregationAuthorization_authorizedAwsRegion :: Lens.Lens' PutAggregationAuthorization Prelude.Text
putAggregationAuthorization_authorizedAwsRegion :: Lens' PutAggregationAuthorization Text
putAggregationAuthorization_authorizedAwsRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAggregationAuthorization' {Text
authorizedAwsRegion :: Text
$sel:authorizedAwsRegion:PutAggregationAuthorization' :: PutAggregationAuthorization -> Text
authorizedAwsRegion} -> Text
authorizedAwsRegion) (\s :: PutAggregationAuthorization
s@PutAggregationAuthorization' {} Text
a -> PutAggregationAuthorization
s {$sel:authorizedAwsRegion:PutAggregationAuthorization' :: Text
authorizedAwsRegion = Text
a} :: PutAggregationAuthorization)

instance Core.AWSRequest PutAggregationAuthorization where
  type
    AWSResponse PutAggregationAuthorization =
      PutAggregationAuthorizationResponse
  request :: (Service -> Service)
-> PutAggregationAuthorization
-> Request PutAggregationAuthorization
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 PutAggregationAuthorization
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutAggregationAuthorization)))
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 AggregationAuthorization
-> Int -> PutAggregationAuthorizationResponse
PutAggregationAuthorizationResponse'
            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
"AggregationAuthorization")
            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 PutAggregationAuthorization where
  hashWithSalt :: Int -> PutAggregationAuthorization -> Int
hashWithSalt Int
_salt PutAggregationAuthorization' {Maybe [Tag]
Text
authorizedAwsRegion :: Text
authorizedAccountId :: Text
tags :: Maybe [Tag]
$sel:authorizedAwsRegion:PutAggregationAuthorization' :: PutAggregationAuthorization -> Text
$sel:authorizedAccountId:PutAggregationAuthorization' :: PutAggregationAuthorization -> Text
$sel:tags:PutAggregationAuthorization' :: PutAggregationAuthorization -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
authorizedAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
authorizedAwsRegion

instance Prelude.NFData PutAggregationAuthorization where
  rnf :: PutAggregationAuthorization -> ()
rnf PutAggregationAuthorization' {Maybe [Tag]
Text
authorizedAwsRegion :: Text
authorizedAccountId :: Text
tags :: Maybe [Tag]
$sel:authorizedAwsRegion:PutAggregationAuthorization' :: PutAggregationAuthorization -> Text
$sel:authorizedAccountId:PutAggregationAuthorization' :: PutAggregationAuthorization -> Text
$sel:tags:PutAggregationAuthorization' :: PutAggregationAuthorization -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
authorizedAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
authorizedAwsRegion

instance Data.ToHeaders PutAggregationAuthorization where
  toHeaders :: PutAggregationAuthorization -> 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
"StarlingDoveService.PutAggregationAuthorization" ::
                          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 PutAggregationAuthorization where
  toJSON :: PutAggregationAuthorization -> Value
toJSON PutAggregationAuthorization' {Maybe [Tag]
Text
authorizedAwsRegion :: Text
authorizedAccountId :: Text
tags :: Maybe [Tag]
$sel:authorizedAwsRegion:PutAggregationAuthorization' :: PutAggregationAuthorization -> Text
$sel:authorizedAccountId:PutAggregationAuthorization' :: PutAggregationAuthorization -> Text
$sel:tags:PutAggregationAuthorization' :: PutAggregationAuthorization -> Maybe [Tag]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AuthorizedAccountId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
authorizedAccountId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AuthorizedAwsRegion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
authorizedAwsRegion)
          ]
      )

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

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

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

-- |
-- Create a value of 'PutAggregationAuthorizationResponse' 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:
--
-- 'aggregationAuthorization', 'putAggregationAuthorizationResponse_aggregationAuthorization' - Returns an AggregationAuthorization object.
--
-- 'httpStatus', 'putAggregationAuthorizationResponse_httpStatus' - The response's http status code.
newPutAggregationAuthorizationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutAggregationAuthorizationResponse
newPutAggregationAuthorizationResponse :: Int -> PutAggregationAuthorizationResponse
newPutAggregationAuthorizationResponse Int
pHttpStatus_ =
  PutAggregationAuthorizationResponse'
    { $sel:aggregationAuthorization:PutAggregationAuthorizationResponse' :: Maybe AggregationAuthorization
aggregationAuthorization =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutAggregationAuthorizationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns an AggregationAuthorization object.
putAggregationAuthorizationResponse_aggregationAuthorization :: Lens.Lens' PutAggregationAuthorizationResponse (Prelude.Maybe AggregationAuthorization)
putAggregationAuthorizationResponse_aggregationAuthorization :: Lens'
  PutAggregationAuthorizationResponse
  (Maybe AggregationAuthorization)
putAggregationAuthorizationResponse_aggregationAuthorization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAggregationAuthorizationResponse' {Maybe AggregationAuthorization
aggregationAuthorization :: Maybe AggregationAuthorization
$sel:aggregationAuthorization:PutAggregationAuthorizationResponse' :: PutAggregationAuthorizationResponse
-> Maybe AggregationAuthorization
aggregationAuthorization} -> Maybe AggregationAuthorization
aggregationAuthorization) (\s :: PutAggregationAuthorizationResponse
s@PutAggregationAuthorizationResponse' {} Maybe AggregationAuthorization
a -> PutAggregationAuthorizationResponse
s {$sel:aggregationAuthorization:PutAggregationAuthorizationResponse' :: Maybe AggregationAuthorization
aggregationAuthorization = Maybe AggregationAuthorization
a} :: PutAggregationAuthorizationResponse)

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

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