{-# 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.AuditManager.RegisterAccount
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables Audit Manager for the specified Amazon Web Services account.
module Amazonka.AuditManager.RegisterAccount
  ( -- * Creating a Request
    RegisterAccount (..),
    newRegisterAccount,

    -- * Request Lenses
    registerAccount_delegatedAdminAccount,
    registerAccount_kmsKey,

    -- * Destructuring the Response
    RegisterAccountResponse (..),
    newRegisterAccountResponse,

    -- * Response Lenses
    registerAccountResponse_status,
    registerAccountResponse_httpStatus,
  )
where

import Amazonka.AuditManager.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:/ 'newRegisterAccount' smart constructor.
data RegisterAccount = RegisterAccount'
  { -- | The delegated administrator account for Audit Manager.
    RegisterAccount -> Maybe Text
delegatedAdminAccount :: Prelude.Maybe Prelude.Text,
    -- | The KMS key details.
    RegisterAccount -> Maybe Text
kmsKey :: Prelude.Maybe Prelude.Text
  }
  deriving (RegisterAccount -> RegisterAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterAccount -> RegisterAccount -> Bool
$c/= :: RegisterAccount -> RegisterAccount -> Bool
== :: RegisterAccount -> RegisterAccount -> Bool
$c== :: RegisterAccount -> RegisterAccount -> Bool
Prelude.Eq, ReadPrec [RegisterAccount]
ReadPrec RegisterAccount
Int -> ReadS RegisterAccount
ReadS [RegisterAccount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterAccount]
$creadListPrec :: ReadPrec [RegisterAccount]
readPrec :: ReadPrec RegisterAccount
$creadPrec :: ReadPrec RegisterAccount
readList :: ReadS [RegisterAccount]
$creadList :: ReadS [RegisterAccount]
readsPrec :: Int -> ReadS RegisterAccount
$creadsPrec :: Int -> ReadS RegisterAccount
Prelude.Read, Int -> RegisterAccount -> ShowS
[RegisterAccount] -> ShowS
RegisterAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterAccount] -> ShowS
$cshowList :: [RegisterAccount] -> ShowS
show :: RegisterAccount -> String
$cshow :: RegisterAccount -> String
showsPrec :: Int -> RegisterAccount -> ShowS
$cshowsPrec :: Int -> RegisterAccount -> ShowS
Prelude.Show, forall x. Rep RegisterAccount x -> RegisterAccount
forall x. RegisterAccount -> Rep RegisterAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterAccount x -> RegisterAccount
$cfrom :: forall x. RegisterAccount -> Rep RegisterAccount x
Prelude.Generic)

-- |
-- Create a value of 'RegisterAccount' 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:
--
-- 'delegatedAdminAccount', 'registerAccount_delegatedAdminAccount' - The delegated administrator account for Audit Manager.
--
-- 'kmsKey', 'registerAccount_kmsKey' - The KMS key details.
newRegisterAccount ::
  RegisterAccount
newRegisterAccount :: RegisterAccount
newRegisterAccount =
  RegisterAccount'
    { $sel:delegatedAdminAccount:RegisterAccount' :: Maybe Text
delegatedAdminAccount =
        forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKey:RegisterAccount' :: Maybe Text
kmsKey = forall a. Maybe a
Prelude.Nothing
    }

-- | The delegated administrator account for Audit Manager.
registerAccount_delegatedAdminAccount :: Lens.Lens' RegisterAccount (Prelude.Maybe Prelude.Text)
registerAccount_delegatedAdminAccount :: Lens' RegisterAccount (Maybe Text)
registerAccount_delegatedAdminAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterAccount' {Maybe Text
delegatedAdminAccount :: Maybe Text
$sel:delegatedAdminAccount:RegisterAccount' :: RegisterAccount -> Maybe Text
delegatedAdminAccount} -> Maybe Text
delegatedAdminAccount) (\s :: RegisterAccount
s@RegisterAccount' {} Maybe Text
a -> RegisterAccount
s {$sel:delegatedAdminAccount:RegisterAccount' :: Maybe Text
delegatedAdminAccount = Maybe Text
a} :: RegisterAccount)

-- | The KMS key details.
registerAccount_kmsKey :: Lens.Lens' RegisterAccount (Prelude.Maybe Prelude.Text)
registerAccount_kmsKey :: Lens' RegisterAccount (Maybe Text)
registerAccount_kmsKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterAccount' {Maybe Text
kmsKey :: Maybe Text
$sel:kmsKey:RegisterAccount' :: RegisterAccount -> Maybe Text
kmsKey} -> Maybe Text
kmsKey) (\s :: RegisterAccount
s@RegisterAccount' {} Maybe Text
a -> RegisterAccount
s {$sel:kmsKey:RegisterAccount' :: Maybe Text
kmsKey = Maybe Text
a} :: RegisterAccount)

instance Core.AWSRequest RegisterAccount where
  type
    AWSResponse RegisterAccount =
      RegisterAccountResponse
  request :: (Service -> Service) -> RegisterAccount -> Request RegisterAccount
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 RegisterAccount
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RegisterAccount)))
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 AccountStatus -> Int -> RegisterAccountResponse
RegisterAccountResponse'
            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
"status")
            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 RegisterAccount where
  hashWithSalt :: Int -> RegisterAccount -> Int
hashWithSalt Int
_salt RegisterAccount' {Maybe Text
kmsKey :: Maybe Text
delegatedAdminAccount :: Maybe Text
$sel:kmsKey:RegisterAccount' :: RegisterAccount -> Maybe Text
$sel:delegatedAdminAccount:RegisterAccount' :: RegisterAccount -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
delegatedAdminAccount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKey

instance Prelude.NFData RegisterAccount where
  rnf :: RegisterAccount -> ()
rnf RegisterAccount' {Maybe Text
kmsKey :: Maybe Text
delegatedAdminAccount :: Maybe Text
$sel:kmsKey:RegisterAccount' :: RegisterAccount -> Maybe Text
$sel:delegatedAdminAccount:RegisterAccount' :: RegisterAccount -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
delegatedAdminAccount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKey

instance Data.ToHeaders RegisterAccount where
  toHeaders :: RegisterAccount -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON RegisterAccount where
  toJSON :: RegisterAccount -> Value
toJSON RegisterAccount' {Maybe Text
kmsKey :: Maybe Text
delegatedAdminAccount :: Maybe Text
$sel:kmsKey:RegisterAccount' :: RegisterAccount -> Maybe Text
$sel:delegatedAdminAccount:RegisterAccount' :: RegisterAccount -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"delegatedAdminAccount" 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
delegatedAdminAccount,
            (Key
"kmsKey" 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
kmsKey
          ]
      )

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

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

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

-- |
-- Create a value of 'RegisterAccountResponse' 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:
--
-- 'status', 'registerAccountResponse_status' - The status of the account registration request.
--
-- 'httpStatus', 'registerAccountResponse_httpStatus' - The response's http status code.
newRegisterAccountResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterAccountResponse
newRegisterAccountResponse :: Int -> RegisterAccountResponse
newRegisterAccountResponse Int
pHttpStatus_ =
  RegisterAccountResponse'
    { $sel:status:RegisterAccountResponse' :: Maybe AccountStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RegisterAccountResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The status of the account registration request.
registerAccountResponse_status :: Lens.Lens' RegisterAccountResponse (Prelude.Maybe AccountStatus)
registerAccountResponse_status :: Lens' RegisterAccountResponse (Maybe AccountStatus)
registerAccountResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterAccountResponse' {Maybe AccountStatus
status :: Maybe AccountStatus
$sel:status:RegisterAccountResponse' :: RegisterAccountResponse -> Maybe AccountStatus
status} -> Maybe AccountStatus
status) (\s :: RegisterAccountResponse
s@RegisterAccountResponse' {} Maybe AccountStatus
a -> RegisterAccountResponse
s {$sel:status:RegisterAccountResponse' :: Maybe AccountStatus
status = Maybe AccountStatus
a} :: RegisterAccountResponse)

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

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