{-# 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.Chime.CreateAccount
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an Amazon Chime account under the administrator\'s AWS account.
-- Only @Team@ account types are currently supported for this action. For
-- more information about different account types, see
-- <https://docs.aws.amazon.com/chime/latest/ag/manage-chime-account.html Managing Your Amazon Chime Accounts>
-- in the /Amazon Chime Administration Guide/.
module Amazonka.Chime.CreateAccount
  ( -- * Creating a Request
    CreateAccount (..),
    newCreateAccount,

    -- * Request Lenses
    createAccount_name,

    -- * Destructuring the Response
    CreateAccountResponse (..),
    newCreateAccountResponse,

    -- * Response Lenses
    createAccountResponse_account,
    createAccountResponse_httpStatus,
  )
where

import Amazonka.Chime.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:/ 'newCreateAccount' smart constructor.
data CreateAccount = CreateAccount'
  { -- | The name of the Amazon Chime account.
    CreateAccount -> Text
name :: Prelude.Text
  }
  deriving (CreateAccount -> CreateAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAccount -> CreateAccount -> Bool
$c/= :: CreateAccount -> CreateAccount -> Bool
== :: CreateAccount -> CreateAccount -> Bool
$c== :: CreateAccount -> CreateAccount -> Bool
Prelude.Eq, ReadPrec [CreateAccount]
ReadPrec CreateAccount
Int -> ReadS CreateAccount
ReadS [CreateAccount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAccount]
$creadListPrec :: ReadPrec [CreateAccount]
readPrec :: ReadPrec CreateAccount
$creadPrec :: ReadPrec CreateAccount
readList :: ReadS [CreateAccount]
$creadList :: ReadS [CreateAccount]
readsPrec :: Int -> ReadS CreateAccount
$creadsPrec :: Int -> ReadS CreateAccount
Prelude.Read, Int -> CreateAccount -> ShowS
[CreateAccount] -> ShowS
CreateAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAccount] -> ShowS
$cshowList :: [CreateAccount] -> ShowS
show :: CreateAccount -> String
$cshow :: CreateAccount -> String
showsPrec :: Int -> CreateAccount -> ShowS
$cshowsPrec :: Int -> CreateAccount -> ShowS
Prelude.Show, forall x. Rep CreateAccount x -> CreateAccount
forall x. CreateAccount -> Rep CreateAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAccount x -> CreateAccount
$cfrom :: forall x. CreateAccount -> Rep CreateAccount x
Prelude.Generic)

-- |
-- Create a value of 'CreateAccount' 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:
--
-- 'name', 'createAccount_name' - The name of the Amazon Chime account.
newCreateAccount ::
  -- | 'name'
  Prelude.Text ->
  CreateAccount
newCreateAccount :: Text -> CreateAccount
newCreateAccount Text
pName_ =
  CreateAccount' {$sel:name:CreateAccount' :: Text
name = Text
pName_}

-- | The name of the Amazon Chime account.
createAccount_name :: Lens.Lens' CreateAccount Prelude.Text
createAccount_name :: Lens' CreateAccount Text
createAccount_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccount' {Text
name :: Text
$sel:name:CreateAccount' :: CreateAccount -> Text
name} -> Text
name) (\s :: CreateAccount
s@CreateAccount' {} Text
a -> CreateAccount
s {$sel:name:CreateAccount' :: Text
name = Text
a} :: CreateAccount)

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

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

instance Data.ToHeaders CreateAccount where
  toHeaders :: CreateAccount -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

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

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

-- |
-- Create a value of 'CreateAccountResponse' 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', 'createAccountResponse_account' - The Amazon Chime account details.
--
-- 'httpStatus', 'createAccountResponse_httpStatus' - The response's http status code.
newCreateAccountResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateAccountResponse
newCreateAccountResponse :: Int -> CreateAccountResponse
newCreateAccountResponse Int
pHttpStatus_ =
  CreateAccountResponse'
    { $sel:account:CreateAccountResponse' :: Maybe Account
account = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateAccountResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Chime account details.
createAccountResponse_account :: Lens.Lens' CreateAccountResponse (Prelude.Maybe Account)
createAccountResponse_account :: Lens' CreateAccountResponse (Maybe Account)
createAccountResponse_account = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccountResponse' {Maybe Account
account :: Maybe Account
$sel:account:CreateAccountResponse' :: CreateAccountResponse -> Maybe Account
account} -> Maybe Account
account) (\s :: CreateAccountResponse
s@CreateAccountResponse' {} Maybe Account
a -> CreateAccountResponse
s {$sel:account:CreateAccountResponse' :: Maybe Account
account = Maybe Account
a} :: CreateAccountResponse)

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

instance Prelude.NFData CreateAccountResponse where
  rnf :: CreateAccountResponse -> ()
rnf CreateAccountResponse' {Int
Maybe Account
httpStatus :: Int
account :: Maybe Account
$sel:httpStatus:CreateAccountResponse' :: CreateAccountResponse -> Int
$sel:account:CreateAccountResponse' :: CreateAccountResponse -> 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