{-# 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.EMR.SetVisibleToAllUsers
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The SetVisibleToAllUsers parameter is no longer supported. Your cluster
-- may be visible to all users in your account. To restrict cluster access
-- using an IAM policy, see
-- <https://docs.aws.amazon.com/emr/latest/ManagementGuide/emr-plan-access-iam.html Identity and Access Management for EMR>.
--
-- Sets the Cluster$VisibleToAllUsers value for an EMR cluster. When
-- @true@, IAM principals in the Amazon Web Services account can perform
-- EMR cluster actions that their IAM policies allow. When @false@, only
-- the IAM principal that created the cluster and the Amazon Web Services
-- account root user can perform EMR actions on the cluster, regardless of
-- IAM permissions policies attached to other IAM principals.
--
-- This action works on running clusters. When you create a cluster, use
-- the RunJobFlowInput$VisibleToAllUsers parameter.
--
-- For more information, see
-- <https://docs.aws.amazon.com/emr/latest/ManagementGuide/security_iam_emr-with-iam.html#security_set_visible_to_all_users Understanding the EMR Cluster VisibleToAllUsers Setting>
-- in the /Amazon EMRManagement Guide/.
module Amazonka.EMR.SetVisibleToAllUsers
  ( -- * Creating a Request
    SetVisibleToAllUsers (..),
    newSetVisibleToAllUsers,

    -- * Request Lenses
    setVisibleToAllUsers_jobFlowIds,
    setVisibleToAllUsers_visibleToAllUsers,

    -- * Destructuring the Response
    SetVisibleToAllUsersResponse (..),
    newSetVisibleToAllUsersResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EMR.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | The input to the SetVisibleToAllUsers action.
--
-- /See:/ 'newSetVisibleToAllUsers' smart constructor.
data SetVisibleToAllUsers = SetVisibleToAllUsers'
  { -- | The unique identifier of the job flow (cluster).
    SetVisibleToAllUsers -> [Text]
jobFlowIds :: [Prelude.Text],
    -- | A value of @true@ indicates that an IAM principal in the Amazon Web
    -- Services account can perform EMR actions on the cluster that the IAM
    -- policies attached to the principal allow. A value of @false@ indicates
    -- that only the IAM principal that created the cluster and the Amazon Web
    -- Services root user can perform EMR actions on the cluster.
    SetVisibleToAllUsers -> Bool
visibleToAllUsers :: Prelude.Bool
  }
  deriving (SetVisibleToAllUsers -> SetVisibleToAllUsers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetVisibleToAllUsers -> SetVisibleToAllUsers -> Bool
$c/= :: SetVisibleToAllUsers -> SetVisibleToAllUsers -> Bool
== :: SetVisibleToAllUsers -> SetVisibleToAllUsers -> Bool
$c== :: SetVisibleToAllUsers -> SetVisibleToAllUsers -> Bool
Prelude.Eq, ReadPrec [SetVisibleToAllUsers]
ReadPrec SetVisibleToAllUsers
Int -> ReadS SetVisibleToAllUsers
ReadS [SetVisibleToAllUsers]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetVisibleToAllUsers]
$creadListPrec :: ReadPrec [SetVisibleToAllUsers]
readPrec :: ReadPrec SetVisibleToAllUsers
$creadPrec :: ReadPrec SetVisibleToAllUsers
readList :: ReadS [SetVisibleToAllUsers]
$creadList :: ReadS [SetVisibleToAllUsers]
readsPrec :: Int -> ReadS SetVisibleToAllUsers
$creadsPrec :: Int -> ReadS SetVisibleToAllUsers
Prelude.Read, Int -> SetVisibleToAllUsers -> ShowS
[SetVisibleToAllUsers] -> ShowS
SetVisibleToAllUsers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetVisibleToAllUsers] -> ShowS
$cshowList :: [SetVisibleToAllUsers] -> ShowS
show :: SetVisibleToAllUsers -> String
$cshow :: SetVisibleToAllUsers -> String
showsPrec :: Int -> SetVisibleToAllUsers -> ShowS
$cshowsPrec :: Int -> SetVisibleToAllUsers -> ShowS
Prelude.Show, forall x. Rep SetVisibleToAllUsers x -> SetVisibleToAllUsers
forall x. SetVisibleToAllUsers -> Rep SetVisibleToAllUsers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetVisibleToAllUsers x -> SetVisibleToAllUsers
$cfrom :: forall x. SetVisibleToAllUsers -> Rep SetVisibleToAllUsers x
Prelude.Generic)

-- |
-- Create a value of 'SetVisibleToAllUsers' 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:
--
-- 'jobFlowIds', 'setVisibleToAllUsers_jobFlowIds' - The unique identifier of the job flow (cluster).
--
-- 'visibleToAllUsers', 'setVisibleToAllUsers_visibleToAllUsers' - A value of @true@ indicates that an IAM principal in the Amazon Web
-- Services account can perform EMR actions on the cluster that the IAM
-- policies attached to the principal allow. A value of @false@ indicates
-- that only the IAM principal that created the cluster and the Amazon Web
-- Services root user can perform EMR actions on the cluster.
newSetVisibleToAllUsers ::
  -- | 'visibleToAllUsers'
  Prelude.Bool ->
  SetVisibleToAllUsers
newSetVisibleToAllUsers :: Bool -> SetVisibleToAllUsers
newSetVisibleToAllUsers Bool
pVisibleToAllUsers_ =
  SetVisibleToAllUsers'
    { $sel:jobFlowIds:SetVisibleToAllUsers' :: [Text]
jobFlowIds = forall a. Monoid a => a
Prelude.mempty,
      $sel:visibleToAllUsers:SetVisibleToAllUsers' :: Bool
visibleToAllUsers = Bool
pVisibleToAllUsers_
    }

-- | The unique identifier of the job flow (cluster).
setVisibleToAllUsers_jobFlowIds :: Lens.Lens' SetVisibleToAllUsers [Prelude.Text]
setVisibleToAllUsers_jobFlowIds :: Lens' SetVisibleToAllUsers [Text]
setVisibleToAllUsers_jobFlowIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetVisibleToAllUsers' {[Text]
jobFlowIds :: [Text]
$sel:jobFlowIds:SetVisibleToAllUsers' :: SetVisibleToAllUsers -> [Text]
jobFlowIds} -> [Text]
jobFlowIds) (\s :: SetVisibleToAllUsers
s@SetVisibleToAllUsers' {} [Text]
a -> SetVisibleToAllUsers
s {$sel:jobFlowIds:SetVisibleToAllUsers' :: [Text]
jobFlowIds = [Text]
a} :: SetVisibleToAllUsers) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A value of @true@ indicates that an IAM principal in the Amazon Web
-- Services account can perform EMR actions on the cluster that the IAM
-- policies attached to the principal allow. A value of @false@ indicates
-- that only the IAM principal that created the cluster and the Amazon Web
-- Services root user can perform EMR actions on the cluster.
setVisibleToAllUsers_visibleToAllUsers :: Lens.Lens' SetVisibleToAllUsers Prelude.Bool
setVisibleToAllUsers_visibleToAllUsers :: Lens' SetVisibleToAllUsers Bool
setVisibleToAllUsers_visibleToAllUsers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetVisibleToAllUsers' {Bool
visibleToAllUsers :: Bool
$sel:visibleToAllUsers:SetVisibleToAllUsers' :: SetVisibleToAllUsers -> Bool
visibleToAllUsers} -> Bool
visibleToAllUsers) (\s :: SetVisibleToAllUsers
s@SetVisibleToAllUsers' {} Bool
a -> SetVisibleToAllUsers
s {$sel:visibleToAllUsers:SetVisibleToAllUsers' :: Bool
visibleToAllUsers = Bool
a} :: SetVisibleToAllUsers)

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

instance Prelude.Hashable SetVisibleToAllUsers where
  hashWithSalt :: Int -> SetVisibleToAllUsers -> Int
hashWithSalt Int
_salt SetVisibleToAllUsers' {Bool
[Text]
visibleToAllUsers :: Bool
jobFlowIds :: [Text]
$sel:visibleToAllUsers:SetVisibleToAllUsers' :: SetVisibleToAllUsers -> Bool
$sel:jobFlowIds:SetVisibleToAllUsers' :: SetVisibleToAllUsers -> [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
jobFlowIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
visibleToAllUsers

instance Prelude.NFData SetVisibleToAllUsers where
  rnf :: SetVisibleToAllUsers -> ()
rnf SetVisibleToAllUsers' {Bool
[Text]
visibleToAllUsers :: Bool
jobFlowIds :: [Text]
$sel:visibleToAllUsers:SetVisibleToAllUsers' :: SetVisibleToAllUsers -> Bool
$sel:jobFlowIds:SetVisibleToAllUsers' :: SetVisibleToAllUsers -> [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Text]
jobFlowIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
visibleToAllUsers

instance Data.ToHeaders SetVisibleToAllUsers where
  toHeaders :: SetVisibleToAllUsers -> [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
"ElasticMapReduce.SetVisibleToAllUsers" ::
                          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 SetVisibleToAllUsers where
  toJSON :: SetVisibleToAllUsers -> Value
toJSON SetVisibleToAllUsers' {Bool
[Text]
visibleToAllUsers :: Bool
jobFlowIds :: [Text]
$sel:visibleToAllUsers:SetVisibleToAllUsers' :: SetVisibleToAllUsers -> Bool
$sel:jobFlowIds:SetVisibleToAllUsers' :: SetVisibleToAllUsers -> [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"JobFlowIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
jobFlowIds),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"VisibleToAllUsers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
visibleToAllUsers)
          ]
      )

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

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

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

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

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