{-# 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.EnableAWSServiceAccess
-- 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 the integration of an Amazon Web Services service (the service
-- that is specified by @ServicePrincipal@) with Organizations. When you
-- enable integration, you allow the specified service to create a
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/using-service-linked-roles.html service-linked role>
-- in all the accounts in your organization. This allows the service to
-- perform operations on your behalf in your organization and its accounts.
--
-- We recommend that you enable integration between Organizations and the
-- specified Amazon Web Services service by using the console or commands
-- that are provided by the specified service. Doing so ensures that the
-- service is aware that it can create the resources that are required for
-- the integration. How the service creates those resources in the
-- organization\'s accounts depends on that service. For more information,
-- see the documentation for the other Amazon Web Services service.
--
-- For more information about enabling services to integrate with
-- Organizations, see
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_integrate_services.html Integrating Organizations with Other Amazon Web Services Services>
-- in the /Organizations User Guide./
--
-- You can only call this operation from the organization\'s management
-- account and only if the organization has
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_org_support-all-features.html enabled all features>.
module Amazonka.Organizations.EnableAWSServiceAccess
  ( -- * Creating a Request
    EnableAWSServiceAccess (..),
    newEnableAWSServiceAccess,

    -- * Request Lenses
    enableAWSServiceAccess_servicePrincipal,

    -- * Destructuring the Response
    EnableAWSServiceAccessResponse (..),
    newEnableAWSServiceAccessResponse,
  )
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:/ 'newEnableAWSServiceAccess' smart constructor.
data EnableAWSServiceAccess = EnableAWSServiceAccess'
  { -- | The service principal name of the Amazon Web Services service for which
    -- you want to enable integration with your organization. This is typically
    -- in the form of a URL, such as
    -- @ @/@service-abbreviation@/@.amazonaws.com@.
    EnableAWSServiceAccess -> Text
servicePrincipal :: Prelude.Text
  }
  deriving (EnableAWSServiceAccess -> EnableAWSServiceAccess -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnableAWSServiceAccess -> EnableAWSServiceAccess -> Bool
$c/= :: EnableAWSServiceAccess -> EnableAWSServiceAccess -> Bool
== :: EnableAWSServiceAccess -> EnableAWSServiceAccess -> Bool
$c== :: EnableAWSServiceAccess -> EnableAWSServiceAccess -> Bool
Prelude.Eq, ReadPrec [EnableAWSServiceAccess]
ReadPrec EnableAWSServiceAccess
Int -> ReadS EnableAWSServiceAccess
ReadS [EnableAWSServiceAccess]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnableAWSServiceAccess]
$creadListPrec :: ReadPrec [EnableAWSServiceAccess]
readPrec :: ReadPrec EnableAWSServiceAccess
$creadPrec :: ReadPrec EnableAWSServiceAccess
readList :: ReadS [EnableAWSServiceAccess]
$creadList :: ReadS [EnableAWSServiceAccess]
readsPrec :: Int -> ReadS EnableAWSServiceAccess
$creadsPrec :: Int -> ReadS EnableAWSServiceAccess
Prelude.Read, Int -> EnableAWSServiceAccess -> ShowS
[EnableAWSServiceAccess] -> ShowS
EnableAWSServiceAccess -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnableAWSServiceAccess] -> ShowS
$cshowList :: [EnableAWSServiceAccess] -> ShowS
show :: EnableAWSServiceAccess -> String
$cshow :: EnableAWSServiceAccess -> String
showsPrec :: Int -> EnableAWSServiceAccess -> ShowS
$cshowsPrec :: Int -> EnableAWSServiceAccess -> ShowS
Prelude.Show, forall x. Rep EnableAWSServiceAccess x -> EnableAWSServiceAccess
forall x. EnableAWSServiceAccess -> Rep EnableAWSServiceAccess x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnableAWSServiceAccess x -> EnableAWSServiceAccess
$cfrom :: forall x. EnableAWSServiceAccess -> Rep EnableAWSServiceAccess x
Prelude.Generic)

-- |
-- Create a value of 'EnableAWSServiceAccess' 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:
--
-- 'servicePrincipal', 'enableAWSServiceAccess_servicePrincipal' - The service principal name of the Amazon Web Services service for which
-- you want to enable integration with your organization. This is typically
-- in the form of a URL, such as
-- @ @/@service-abbreviation@/@.amazonaws.com@.
newEnableAWSServiceAccess ::
  -- | 'servicePrincipal'
  Prelude.Text ->
  EnableAWSServiceAccess
newEnableAWSServiceAccess :: Text -> EnableAWSServiceAccess
newEnableAWSServiceAccess Text
pServicePrincipal_ =
  EnableAWSServiceAccess'
    { $sel:servicePrincipal:EnableAWSServiceAccess' :: Text
servicePrincipal =
        Text
pServicePrincipal_
    }

-- | The service principal name of the Amazon Web Services service for which
-- you want to enable integration with your organization. This is typically
-- in the form of a URL, such as
-- @ @/@service-abbreviation@/@.amazonaws.com@.
enableAWSServiceAccess_servicePrincipal :: Lens.Lens' EnableAWSServiceAccess Prelude.Text
enableAWSServiceAccess_servicePrincipal :: Lens' EnableAWSServiceAccess Text
enableAWSServiceAccess_servicePrincipal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableAWSServiceAccess' {Text
servicePrincipal :: Text
$sel:servicePrincipal:EnableAWSServiceAccess' :: EnableAWSServiceAccess -> Text
servicePrincipal} -> Text
servicePrincipal) (\s :: EnableAWSServiceAccess
s@EnableAWSServiceAccess' {} Text
a -> EnableAWSServiceAccess
s {$sel:servicePrincipal:EnableAWSServiceAccess' :: Text
servicePrincipal = Text
a} :: EnableAWSServiceAccess)

instance Core.AWSRequest EnableAWSServiceAccess where
  type
    AWSResponse EnableAWSServiceAccess =
      EnableAWSServiceAccessResponse
  request :: (Service -> Service)
-> EnableAWSServiceAccess -> Request EnableAWSServiceAccess
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 EnableAWSServiceAccess
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse EnableAWSServiceAccess)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      EnableAWSServiceAccessResponse
EnableAWSServiceAccessResponse'

instance Prelude.Hashable EnableAWSServiceAccess where
  hashWithSalt :: Int -> EnableAWSServiceAccess -> Int
hashWithSalt Int
_salt EnableAWSServiceAccess' {Text
servicePrincipal :: Text
$sel:servicePrincipal:EnableAWSServiceAccess' :: EnableAWSServiceAccess -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
servicePrincipal

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

instance Data.ToHeaders EnableAWSServiceAccess where
  toHeaders :: EnableAWSServiceAccess -> [Header]
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 -> [Header]
Data.=# ( ByteString
"AWSOrganizationsV20161128.EnableAWSServiceAccess" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

-- | /See:/ 'newEnableAWSServiceAccessResponse' smart constructor.
data EnableAWSServiceAccessResponse = EnableAWSServiceAccessResponse'
  {
  }
  deriving (EnableAWSServiceAccessResponse
-> EnableAWSServiceAccessResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnableAWSServiceAccessResponse
-> EnableAWSServiceAccessResponse -> Bool
$c/= :: EnableAWSServiceAccessResponse
-> EnableAWSServiceAccessResponse -> Bool
== :: EnableAWSServiceAccessResponse
-> EnableAWSServiceAccessResponse -> Bool
$c== :: EnableAWSServiceAccessResponse
-> EnableAWSServiceAccessResponse -> Bool
Prelude.Eq, ReadPrec [EnableAWSServiceAccessResponse]
ReadPrec EnableAWSServiceAccessResponse
Int -> ReadS EnableAWSServiceAccessResponse
ReadS [EnableAWSServiceAccessResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnableAWSServiceAccessResponse]
$creadListPrec :: ReadPrec [EnableAWSServiceAccessResponse]
readPrec :: ReadPrec EnableAWSServiceAccessResponse
$creadPrec :: ReadPrec EnableAWSServiceAccessResponse
readList :: ReadS [EnableAWSServiceAccessResponse]
$creadList :: ReadS [EnableAWSServiceAccessResponse]
readsPrec :: Int -> ReadS EnableAWSServiceAccessResponse
$creadsPrec :: Int -> ReadS EnableAWSServiceAccessResponse
Prelude.Read, Int -> EnableAWSServiceAccessResponse -> ShowS
[EnableAWSServiceAccessResponse] -> ShowS
EnableAWSServiceAccessResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnableAWSServiceAccessResponse] -> ShowS
$cshowList :: [EnableAWSServiceAccessResponse] -> ShowS
show :: EnableAWSServiceAccessResponse -> String
$cshow :: EnableAWSServiceAccessResponse -> String
showsPrec :: Int -> EnableAWSServiceAccessResponse -> ShowS
$cshowsPrec :: Int -> EnableAWSServiceAccessResponse -> ShowS
Prelude.Show, forall x.
Rep EnableAWSServiceAccessResponse x
-> EnableAWSServiceAccessResponse
forall x.
EnableAWSServiceAccessResponse
-> Rep EnableAWSServiceAccessResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep EnableAWSServiceAccessResponse x
-> EnableAWSServiceAccessResponse
$cfrom :: forall x.
EnableAWSServiceAccessResponse
-> Rep EnableAWSServiceAccessResponse x
Prelude.Generic)

-- |
-- Create a value of 'EnableAWSServiceAccessResponse' 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.
newEnableAWSServiceAccessResponse ::
  EnableAWSServiceAccessResponse
newEnableAWSServiceAccessResponse :: EnableAWSServiceAccessResponse
newEnableAWSServiceAccessResponse =
  EnableAWSServiceAccessResponse
EnableAWSServiceAccessResponse'

instance
  Prelude.NFData
    EnableAWSServiceAccessResponse
  where
  rnf :: EnableAWSServiceAccessResponse -> ()
rnf EnableAWSServiceAccessResponse
_ = ()