{-# 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.RAM.EnableSharingWithAwsOrganization
-- 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 resource sharing within your organization in Organizations.
-- Calling this operation enables RAM to retrieve information about the
-- organization and its structure. This lets you share resources with all
-- of the accounts in an organization by specifying the organization\'s ID,
-- or all of the accounts in an organizational unit (OU) by specifying the
-- OU\'s ID. Until you enable sharing within the organization, you can
-- specify only individual Amazon Web Services accounts, or for supported
-- resource types, IAM users and roles.
--
-- You must call this operation from an IAM user or role in the
-- organization\'s management account.
module Amazonka.RAM.EnableSharingWithAwsOrganization
  ( -- * Creating a Request
    EnableSharingWithAwsOrganization (..),
    newEnableSharingWithAwsOrganization,

    -- * Destructuring the Response
    EnableSharingWithAwsOrganizationResponse (..),
    newEnableSharingWithAwsOrganizationResponse,

    -- * Response Lenses
    enableSharingWithAwsOrganizationResponse_returnValue,
    enableSharingWithAwsOrganizationResponse_httpStatus,
  )
where

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 Amazonka.RAM.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

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

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

instance
  Core.AWSRequest
    EnableSharingWithAwsOrganization
  where
  type
    AWSResponse EnableSharingWithAwsOrganization =
      EnableSharingWithAwsOrganizationResponse
  request :: (Service -> Service)
-> EnableSharingWithAwsOrganization
-> Request EnableSharingWithAwsOrganization
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 EnableSharingWithAwsOrganization
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse EnableSharingWithAwsOrganization)))
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 Bool -> Int -> EnableSharingWithAwsOrganizationResponse
EnableSharingWithAwsOrganizationResponse'
            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
"returnValue")
            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
    EnableSharingWithAwsOrganization
  where
  hashWithSalt :: Int -> EnableSharingWithAwsOrganization -> Int
hashWithSalt Int
_salt EnableSharingWithAwsOrganization
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

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

instance
  Data.ToHeaders
    EnableSharingWithAwsOrganization
  where
  toHeaders :: EnableSharingWithAwsOrganization -> 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 EnableSharingWithAwsOrganization where
  toJSON :: EnableSharingWithAwsOrganization -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

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

-- | /See:/ 'newEnableSharingWithAwsOrganizationResponse' smart constructor.
data EnableSharingWithAwsOrganizationResponse = EnableSharingWithAwsOrganizationResponse'
  { -- | A return value of @true@ indicates that the request succeeded. A value
    -- of @false@ indicates that the request failed.
    EnableSharingWithAwsOrganizationResponse -> Maybe Bool
returnValue :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    EnableSharingWithAwsOrganizationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (EnableSharingWithAwsOrganizationResponse
-> EnableSharingWithAwsOrganizationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnableSharingWithAwsOrganizationResponse
-> EnableSharingWithAwsOrganizationResponse -> Bool
$c/= :: EnableSharingWithAwsOrganizationResponse
-> EnableSharingWithAwsOrganizationResponse -> Bool
== :: EnableSharingWithAwsOrganizationResponse
-> EnableSharingWithAwsOrganizationResponse -> Bool
$c== :: EnableSharingWithAwsOrganizationResponse
-> EnableSharingWithAwsOrganizationResponse -> Bool
Prelude.Eq, ReadPrec [EnableSharingWithAwsOrganizationResponse]
ReadPrec EnableSharingWithAwsOrganizationResponse
Int -> ReadS EnableSharingWithAwsOrganizationResponse
ReadS [EnableSharingWithAwsOrganizationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnableSharingWithAwsOrganizationResponse]
$creadListPrec :: ReadPrec [EnableSharingWithAwsOrganizationResponse]
readPrec :: ReadPrec EnableSharingWithAwsOrganizationResponse
$creadPrec :: ReadPrec EnableSharingWithAwsOrganizationResponse
readList :: ReadS [EnableSharingWithAwsOrganizationResponse]
$creadList :: ReadS [EnableSharingWithAwsOrganizationResponse]
readsPrec :: Int -> ReadS EnableSharingWithAwsOrganizationResponse
$creadsPrec :: Int -> ReadS EnableSharingWithAwsOrganizationResponse
Prelude.Read, Int -> EnableSharingWithAwsOrganizationResponse -> ShowS
[EnableSharingWithAwsOrganizationResponse] -> ShowS
EnableSharingWithAwsOrganizationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnableSharingWithAwsOrganizationResponse] -> ShowS
$cshowList :: [EnableSharingWithAwsOrganizationResponse] -> ShowS
show :: EnableSharingWithAwsOrganizationResponse -> String
$cshow :: EnableSharingWithAwsOrganizationResponse -> String
showsPrec :: Int -> EnableSharingWithAwsOrganizationResponse -> ShowS
$cshowsPrec :: Int -> EnableSharingWithAwsOrganizationResponse -> ShowS
Prelude.Show, forall x.
Rep EnableSharingWithAwsOrganizationResponse x
-> EnableSharingWithAwsOrganizationResponse
forall x.
EnableSharingWithAwsOrganizationResponse
-> Rep EnableSharingWithAwsOrganizationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep EnableSharingWithAwsOrganizationResponse x
-> EnableSharingWithAwsOrganizationResponse
$cfrom :: forall x.
EnableSharingWithAwsOrganizationResponse
-> Rep EnableSharingWithAwsOrganizationResponse x
Prelude.Generic)

-- |
-- Create a value of 'EnableSharingWithAwsOrganizationResponse' 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:
--
-- 'returnValue', 'enableSharingWithAwsOrganizationResponse_returnValue' - A return value of @true@ indicates that the request succeeded. A value
-- of @false@ indicates that the request failed.
--
-- 'httpStatus', 'enableSharingWithAwsOrganizationResponse_httpStatus' - The response's http status code.
newEnableSharingWithAwsOrganizationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  EnableSharingWithAwsOrganizationResponse
newEnableSharingWithAwsOrganizationResponse :: Int -> EnableSharingWithAwsOrganizationResponse
newEnableSharingWithAwsOrganizationResponse
  Int
pHttpStatus_ =
    EnableSharingWithAwsOrganizationResponse'
      { $sel:returnValue:EnableSharingWithAwsOrganizationResponse' :: Maybe Bool
returnValue =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:EnableSharingWithAwsOrganizationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | A return value of @true@ indicates that the request succeeded. A value
-- of @false@ indicates that the request failed.
enableSharingWithAwsOrganizationResponse_returnValue :: Lens.Lens' EnableSharingWithAwsOrganizationResponse (Prelude.Maybe Prelude.Bool)
enableSharingWithAwsOrganizationResponse_returnValue :: Lens' EnableSharingWithAwsOrganizationResponse (Maybe Bool)
enableSharingWithAwsOrganizationResponse_returnValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableSharingWithAwsOrganizationResponse' {Maybe Bool
returnValue :: Maybe Bool
$sel:returnValue:EnableSharingWithAwsOrganizationResponse' :: EnableSharingWithAwsOrganizationResponse -> Maybe Bool
returnValue} -> Maybe Bool
returnValue) (\s :: EnableSharingWithAwsOrganizationResponse
s@EnableSharingWithAwsOrganizationResponse' {} Maybe Bool
a -> EnableSharingWithAwsOrganizationResponse
s {$sel:returnValue:EnableSharingWithAwsOrganizationResponse' :: Maybe Bool
returnValue = Maybe Bool
a} :: EnableSharingWithAwsOrganizationResponse)

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

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