{-# 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.CreateOrganization
-- 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 Web Services organization. The account whose user is
-- calling the @CreateOrganization@ operation automatically becomes the
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_getting-started_concepts.html#account management account>
-- of the new organization.
--
-- This operation must be called using credentials from the account that is
-- to become the new organization\'s management account. The principal must
-- also have the relevant IAM permissions.
--
-- By default (or if you set the @FeatureSet@ parameter to @ALL@), the new
-- organization is created with all features enabled and service control
-- policies automatically enabled in the root. If you instead choose to
-- create the organization supporting only the consolidated billing
-- features by setting the @FeatureSet@ parameter to
-- @CONSOLIDATED_BILLING\"@, no policy types are enabled by default, and
-- you can\'t use organization policies
module Amazonka.Organizations.CreateOrganization
  ( -- * Creating a Request
    CreateOrganization (..),
    newCreateOrganization,

    -- * Request Lenses
    createOrganization_featureSet,

    -- * Destructuring the Response
    CreateOrganizationResponse (..),
    newCreateOrganizationResponse,

    -- * Response Lenses
    createOrganizationResponse_organization,
    createOrganizationResponse_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:/ 'newCreateOrganization' smart constructor.
data CreateOrganization = CreateOrganization'
  { -- | Specifies the feature set supported by the new organization. Each
    -- feature set supports different levels of functionality.
    --
    -- -   @CONSOLIDATED_BILLING@: All member accounts have their bills
    --     consolidated to and paid by the management account. For more
    --     information, see
    --     <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_getting-started_concepts.html#feature-set-cb-only Consolidated billing>
    --     in the /Organizations User Guide./
    --
    --     The consolidated billing feature subset isn\'t available for
    --     organizations in the Amazon Web Services GovCloud (US) Region.
    --
    -- -   @ALL@: In addition to all the features supported by the consolidated
    --     billing feature set, the management account can also apply any
    --     policy type to any member account in the organization. For more
    --     information, see
    --     <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_getting-started_concepts.html#feature-set-all All features>
    --     in the /Organizations User Guide./
    CreateOrganization -> Maybe OrganizationFeatureSet
featureSet :: Prelude.Maybe OrganizationFeatureSet
  }
  deriving (CreateOrganization -> CreateOrganization -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOrganization -> CreateOrganization -> Bool
$c/= :: CreateOrganization -> CreateOrganization -> Bool
== :: CreateOrganization -> CreateOrganization -> Bool
$c== :: CreateOrganization -> CreateOrganization -> Bool
Prelude.Eq, ReadPrec [CreateOrganization]
ReadPrec CreateOrganization
Int -> ReadS CreateOrganization
ReadS [CreateOrganization]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOrganization]
$creadListPrec :: ReadPrec [CreateOrganization]
readPrec :: ReadPrec CreateOrganization
$creadPrec :: ReadPrec CreateOrganization
readList :: ReadS [CreateOrganization]
$creadList :: ReadS [CreateOrganization]
readsPrec :: Int -> ReadS CreateOrganization
$creadsPrec :: Int -> ReadS CreateOrganization
Prelude.Read, Int -> CreateOrganization -> ShowS
[CreateOrganization] -> ShowS
CreateOrganization -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOrganization] -> ShowS
$cshowList :: [CreateOrganization] -> ShowS
show :: CreateOrganization -> String
$cshow :: CreateOrganization -> String
showsPrec :: Int -> CreateOrganization -> ShowS
$cshowsPrec :: Int -> CreateOrganization -> ShowS
Prelude.Show, forall x. Rep CreateOrganization x -> CreateOrganization
forall x. CreateOrganization -> Rep CreateOrganization x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateOrganization x -> CreateOrganization
$cfrom :: forall x. CreateOrganization -> Rep CreateOrganization x
Prelude.Generic)

-- |
-- Create a value of 'CreateOrganization' 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:
--
-- 'featureSet', 'createOrganization_featureSet' - Specifies the feature set supported by the new organization. Each
-- feature set supports different levels of functionality.
--
-- -   @CONSOLIDATED_BILLING@: All member accounts have their bills
--     consolidated to and paid by the management account. For more
--     information, see
--     <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_getting-started_concepts.html#feature-set-cb-only Consolidated billing>
--     in the /Organizations User Guide./
--
--     The consolidated billing feature subset isn\'t available for
--     organizations in the Amazon Web Services GovCloud (US) Region.
--
-- -   @ALL@: In addition to all the features supported by the consolidated
--     billing feature set, the management account can also apply any
--     policy type to any member account in the organization. For more
--     information, see
--     <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_getting-started_concepts.html#feature-set-all All features>
--     in the /Organizations User Guide./
newCreateOrganization ::
  CreateOrganization
newCreateOrganization :: CreateOrganization
newCreateOrganization =
  CreateOrganization' {$sel:featureSet:CreateOrganization' :: Maybe OrganizationFeatureSet
featureSet = forall a. Maybe a
Prelude.Nothing}

-- | Specifies the feature set supported by the new organization. Each
-- feature set supports different levels of functionality.
--
-- -   @CONSOLIDATED_BILLING@: All member accounts have their bills
--     consolidated to and paid by the management account. For more
--     information, see
--     <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_getting-started_concepts.html#feature-set-cb-only Consolidated billing>
--     in the /Organizations User Guide./
--
--     The consolidated billing feature subset isn\'t available for
--     organizations in the Amazon Web Services GovCloud (US) Region.
--
-- -   @ALL@: In addition to all the features supported by the consolidated
--     billing feature set, the management account can also apply any
--     policy type to any member account in the organization. For more
--     information, see
--     <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_getting-started_concepts.html#feature-set-all All features>
--     in the /Organizations User Guide./
createOrganization_featureSet :: Lens.Lens' CreateOrganization (Prelude.Maybe OrganizationFeatureSet)
createOrganization_featureSet :: Lens' CreateOrganization (Maybe OrganizationFeatureSet)
createOrganization_featureSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOrganization' {Maybe OrganizationFeatureSet
featureSet :: Maybe OrganizationFeatureSet
$sel:featureSet:CreateOrganization' :: CreateOrganization -> Maybe OrganizationFeatureSet
featureSet} -> Maybe OrganizationFeatureSet
featureSet) (\s :: CreateOrganization
s@CreateOrganization' {} Maybe OrganizationFeatureSet
a -> CreateOrganization
s {$sel:featureSet:CreateOrganization' :: Maybe OrganizationFeatureSet
featureSet = Maybe OrganizationFeatureSet
a} :: CreateOrganization)

instance Core.AWSRequest CreateOrganization where
  type
    AWSResponse CreateOrganization =
      CreateOrganizationResponse
  request :: (Service -> Service)
-> CreateOrganization -> Request CreateOrganization
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 CreateOrganization
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateOrganization)))
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 Organization -> Int -> CreateOrganizationResponse
CreateOrganizationResponse'
            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
"Organization")
            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 CreateOrganization where
  hashWithSalt :: Int -> CreateOrganization -> Int
hashWithSalt Int
_salt CreateOrganization' {Maybe OrganizationFeatureSet
featureSet :: Maybe OrganizationFeatureSet
$sel:featureSet:CreateOrganization' :: CreateOrganization -> Maybe OrganizationFeatureSet
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrganizationFeatureSet
featureSet

instance Prelude.NFData CreateOrganization where
  rnf :: CreateOrganization -> ()
rnf CreateOrganization' {Maybe OrganizationFeatureSet
featureSet :: Maybe OrganizationFeatureSet
$sel:featureSet:CreateOrganization' :: CreateOrganization -> Maybe OrganizationFeatureSet
..} = forall a. NFData a => a -> ()
Prelude.rnf Maybe OrganizationFeatureSet
featureSet

instance Data.ToHeaders CreateOrganization where
  toHeaders :: CreateOrganization -> 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.CreateOrganization" ::
                          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 CreateOrganization where
  toJSON :: CreateOrganization -> Value
toJSON CreateOrganization' {Maybe OrganizationFeatureSet
featureSet :: Maybe OrganizationFeatureSet
$sel:featureSet:CreateOrganization' :: CreateOrganization -> Maybe OrganizationFeatureSet
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"FeatureSet" 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 OrganizationFeatureSet
featureSet]
      )

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

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

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

-- |
-- Create a value of 'CreateOrganizationResponse' 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:
--
-- 'organization', 'createOrganizationResponse_organization' - A structure that contains details about the newly created organization.
--
-- 'httpStatus', 'createOrganizationResponse_httpStatus' - The response's http status code.
newCreateOrganizationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateOrganizationResponse
newCreateOrganizationResponse :: Int -> CreateOrganizationResponse
newCreateOrganizationResponse Int
pHttpStatus_ =
  CreateOrganizationResponse'
    { $sel:organization:CreateOrganizationResponse' :: Maybe Organization
organization =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateOrganizationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A structure that contains details about the newly created organization.
createOrganizationResponse_organization :: Lens.Lens' CreateOrganizationResponse (Prelude.Maybe Organization)
createOrganizationResponse_organization :: Lens' CreateOrganizationResponse (Maybe Organization)
createOrganizationResponse_organization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOrganizationResponse' {Maybe Organization
organization :: Maybe Organization
$sel:organization:CreateOrganizationResponse' :: CreateOrganizationResponse -> Maybe Organization
organization} -> Maybe Organization
organization) (\s :: CreateOrganizationResponse
s@CreateOrganizationResponse' {} Maybe Organization
a -> CreateOrganizationResponse
s {$sel:organization:CreateOrganizationResponse' :: Maybe Organization
organization = Maybe Organization
a} :: CreateOrganizationResponse)

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

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