{-# 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.Organizations.DescribeAccount
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves Organizations-related information about the specified account.
--
-- This operation can be called only from the organization\'s management
-- account or by a member account that is a delegated administrator for an
-- Amazon Web Services service.
module Amazonka.Organizations.DescribeAccount
  ( -- * Creating a Request
    DescribeAccount (..),
    newDescribeAccount,

    -- * Request Lenses
    describeAccount_accountId,

    -- * Destructuring the Response
    DescribeAccountResponse (..),
    newDescribeAccountResponse,

    -- * Response Lenses
    describeAccountResponse_account,
    describeAccountResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeAccount' smart constructor.
data DescribeAccount = DescribeAccount'
  { -- | The unique identifier (ID) of the Amazon Web Services account that you
    -- want information about. You can get the ID from the ListAccounts or
    -- ListAccountsForParent operations.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> for an account ID
    -- string requires exactly 12 digits.
    DescribeAccount -> Text
accountId :: Prelude.Text
  }
  deriving (DescribeAccount -> DescribeAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAccount -> DescribeAccount -> Bool
$c/= :: DescribeAccount -> DescribeAccount -> Bool
== :: DescribeAccount -> DescribeAccount -> Bool
$c== :: DescribeAccount -> DescribeAccount -> Bool
Prelude.Eq, ReadPrec [DescribeAccount]
ReadPrec DescribeAccount
Int -> ReadS DescribeAccount
ReadS [DescribeAccount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAccount]
$creadListPrec :: ReadPrec [DescribeAccount]
readPrec :: ReadPrec DescribeAccount
$creadPrec :: ReadPrec DescribeAccount
readList :: ReadS [DescribeAccount]
$creadList :: ReadS [DescribeAccount]
readsPrec :: Int -> ReadS DescribeAccount
$creadsPrec :: Int -> ReadS DescribeAccount
Prelude.Read, Int -> DescribeAccount -> ShowS
[DescribeAccount] -> ShowS
DescribeAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAccount] -> ShowS
$cshowList :: [DescribeAccount] -> ShowS
show :: DescribeAccount -> String
$cshow :: DescribeAccount -> String
showsPrec :: Int -> DescribeAccount -> ShowS
$cshowsPrec :: Int -> DescribeAccount -> ShowS
Prelude.Show, forall x. Rep DescribeAccount x -> DescribeAccount
forall x. DescribeAccount -> Rep DescribeAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAccount x -> DescribeAccount
$cfrom :: forall x. DescribeAccount -> Rep DescribeAccount x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAccount' 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:
--
-- 'accountId', 'describeAccount_accountId' - The unique identifier (ID) of the Amazon Web Services account that you
-- want information about. You can get the ID from the ListAccounts or
-- ListAccountsForParent operations.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for an account ID
-- string requires exactly 12 digits.
newDescribeAccount ::
  -- | 'accountId'
  Prelude.Text ->
  DescribeAccount
newDescribeAccount :: Text -> DescribeAccount
newDescribeAccount Text
pAccountId_ =
  DescribeAccount' {$sel:accountId:DescribeAccount' :: Text
accountId = Text
pAccountId_}

-- | The unique identifier (ID) of the Amazon Web Services account that you
-- want information about. You can get the ID from the ListAccounts or
-- ListAccountsForParent operations.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for an account ID
-- string requires exactly 12 digits.
describeAccount_accountId :: Lens.Lens' DescribeAccount Prelude.Text
describeAccount_accountId :: Lens' DescribeAccount Text
describeAccount_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAccount' {Text
accountId :: Text
$sel:accountId:DescribeAccount' :: DescribeAccount -> Text
accountId} -> Text
accountId) (\s :: DescribeAccount
s@DescribeAccount' {} Text
a -> DescribeAccount
s {$sel:accountId:DescribeAccount' :: Text
accountId = Text
a} :: DescribeAccount)

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

instance Prelude.NFData DescribeAccount where
  rnf :: DescribeAccount -> ()
rnf DescribeAccount' {Text
accountId :: Text
$sel:accountId:DescribeAccount' :: DescribeAccount -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
accountId

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

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

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

-- | /See:/ 'newDescribeAccountResponse' smart constructor.
data DescribeAccountResponse = DescribeAccountResponse'
  { -- | A structure that contains information about the requested account.
    DescribeAccountResponse -> Maybe Account
account :: Prelude.Maybe Account,
    -- | The response's http status code.
    DescribeAccountResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeAccountResponse -> DescribeAccountResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAccountResponse -> DescribeAccountResponse -> Bool
$c/= :: DescribeAccountResponse -> DescribeAccountResponse -> Bool
== :: DescribeAccountResponse -> DescribeAccountResponse -> Bool
$c== :: DescribeAccountResponse -> DescribeAccountResponse -> Bool
Prelude.Eq, Int -> DescribeAccountResponse -> ShowS
[DescribeAccountResponse] -> ShowS
DescribeAccountResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAccountResponse] -> ShowS
$cshowList :: [DescribeAccountResponse] -> ShowS
show :: DescribeAccountResponse -> String
$cshow :: DescribeAccountResponse -> String
showsPrec :: Int -> DescribeAccountResponse -> ShowS
$cshowsPrec :: Int -> DescribeAccountResponse -> ShowS
Prelude.Show, forall x. Rep DescribeAccountResponse x -> DescribeAccountResponse
forall x. DescribeAccountResponse -> Rep DescribeAccountResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAccountResponse x -> DescribeAccountResponse
$cfrom :: forall x. DescribeAccountResponse -> Rep DescribeAccountResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAccountResponse' 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:
--
-- 'account', 'describeAccountResponse_account' - A structure that contains information about the requested account.
--
-- 'httpStatus', 'describeAccountResponse_httpStatus' - The response's http status code.
newDescribeAccountResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeAccountResponse
newDescribeAccountResponse :: Int -> DescribeAccountResponse
newDescribeAccountResponse Int
pHttpStatus_ =
  DescribeAccountResponse'
    { $sel:account:DescribeAccountResponse' :: Maybe Account
account = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeAccountResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A structure that contains information about the requested account.
describeAccountResponse_account :: Lens.Lens' DescribeAccountResponse (Prelude.Maybe Account)
describeAccountResponse_account :: Lens' DescribeAccountResponse (Maybe Account)
describeAccountResponse_account = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAccountResponse' {Maybe Account
account :: Maybe Account
$sel:account:DescribeAccountResponse' :: DescribeAccountResponse -> Maybe Account
account} -> Maybe Account
account) (\s :: DescribeAccountResponse
s@DescribeAccountResponse' {} Maybe Account
a -> DescribeAccountResponse
s {$sel:account:DescribeAccountResponse' :: Maybe Account
account = Maybe Account
a} :: DescribeAccountResponse)

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

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