{-# 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.DisableAWSServiceAccess
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disables the integration of an Amazon Web Services service (the service
-- that is specified by @ServicePrincipal@) with Organizations. When you
-- disable integration, the specified service no longer can create a
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/using-service-linked-roles.html service-linked role>
-- in /new/ accounts in your organization. This means the service can\'t
-- perform operations on your behalf on any new accounts in your
-- organization. The service can still perform operations in older accounts
-- until the service completes its clean-up from Organizations.
--
-- We __/strongly recommend/__ that you don\'t use this command to disable
-- integration between Organizations and the specified Amazon Web Services
-- service. Instead, use the console or commands that are provided by the
-- specified service. This lets the trusted service perform any required
-- initialization when enabling trusted access, such as creating any
-- required resources and any required clean up of resources when disabling
-- trusted access.
--
-- For information about how to disable trusted service access to your
-- organization using the trusted service, see the __Learn more__ link
-- under the __Supports Trusted Access__ column at
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_integrate_services_list.html Amazon Web Services services that you can use with Organizations>.
-- on this page.
--
-- If you disable access by using this command, it causes the following
-- actions to occur:
--
-- -   The service can no longer create a service-linked role in the
--     accounts in your organization. This means that the service can\'t
--     perform operations on your behalf on any new accounts in your
--     organization. The service can still perform operations in older
--     accounts until the service completes its clean-up from
--     Organizations.
--
-- -   The service can no longer perform tasks in the member accounts in
--     the organization, unless those operations are explicitly permitted
--     by the IAM policies that are attached to your roles. This includes
--     any data aggregation from the member accounts to the management
--     account, or to a delegated administrator account, where relevant.
--
-- -   Some services detect this and clean up any remaining data or
--     resources related to the integration, while other services stop
--     accessing the organization but leave any historical data and
--     configuration in place to support a possible re-enabling of the
--     integration.
--
-- Using the other service\'s console or commands to disable the
-- integration ensures that the other service is aware that it can clean up
-- any resources that are required only for the integration. How the
-- service cleans up its resources in the organization\'s accounts depends
-- on that service. For more information, see the documentation for the
-- other Amazon Web Services service.
--
-- After you perform the @DisableAWSServiceAccess@ operation, the specified
-- service can no longer perform operations in your organization\'s
-- accounts
--
-- For more information about integrating other services with
-- Organizations, including the list of services that work 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./
--
-- This operation can be called only from the organization\'s management
-- account.
module Amazonka.Organizations.DisableAWSServiceAccess
  ( -- * Creating a Request
    DisableAWSServiceAccess (..),
    newDisableAWSServiceAccess,

    -- * Request Lenses
    disableAWSServiceAccess_servicePrincipal,

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

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

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

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

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

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

instance Data.ToHeaders DisableAWSServiceAccess where
  toHeaders :: DisableAWSServiceAccess -> [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.DisableAWSServiceAccess" ::
                          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 DisableAWSServiceAccess where
  toJSON :: DisableAWSServiceAccess -> Value
toJSON DisableAWSServiceAccess' {Text
servicePrincipal :: Text
$sel:servicePrincipal:DisableAWSServiceAccess' :: DisableAWSServiceAccess -> 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 DisableAWSServiceAccess where
  toPath :: DisableAWSServiceAccess -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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