{-# 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.OpsWorks.SetPermission
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Specifies a user\'s permissions. For more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingsecurity.html Security and Permissions>.
--
-- __Required Permissions__: To use this action, an IAM user must have a
-- Manage permissions level for the stack, or an attached policy that
-- explicitly grants permissions. For more information on user permissions,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
module Amazonka.OpsWorks.SetPermission
  ( -- * Creating a Request
    SetPermission (..),
    newSetPermission,

    -- * Request Lenses
    setPermission_allowSsh,
    setPermission_allowSudo,
    setPermission_level,
    setPermission_stackId,
    setPermission_iamUserArn,

    -- * Destructuring the Response
    SetPermissionResponse (..),
    newSetPermissionResponse,
  )
where

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

-- | /See:/ 'newSetPermission' smart constructor.
data SetPermission = SetPermission'
  { -- | The user is allowed to use SSH to communicate with the instance.
    SetPermission -> Maybe Bool
allowSsh :: Prelude.Maybe Prelude.Bool,
    -- | The user is allowed to use __sudo__ to elevate privileges.
    SetPermission -> Maybe Bool
allowSudo :: Prelude.Maybe Prelude.Bool,
    -- | The user\'s permission level, which must be set to one of the following
    -- strings. You cannot set your own permissions level.
    --
    -- -   @deny@
    --
    -- -   @show@
    --
    -- -   @deploy@
    --
    -- -   @manage@
    --
    -- -   @iam_only@
    --
    -- For more information about the permissions associated with these levels,
    -- see
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
    SetPermission -> Maybe Text
level :: Prelude.Maybe Prelude.Text,
    -- | The stack ID.
    SetPermission -> Text
stackId :: Prelude.Text,
    -- | The user\'s IAM ARN. This can also be a federated user\'s ARN.
    SetPermission -> Text
iamUserArn :: Prelude.Text
  }
  deriving (SetPermission -> SetPermission -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetPermission -> SetPermission -> Bool
$c/= :: SetPermission -> SetPermission -> Bool
== :: SetPermission -> SetPermission -> Bool
$c== :: SetPermission -> SetPermission -> Bool
Prelude.Eq, ReadPrec [SetPermission]
ReadPrec SetPermission
Int -> ReadS SetPermission
ReadS [SetPermission]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetPermission]
$creadListPrec :: ReadPrec [SetPermission]
readPrec :: ReadPrec SetPermission
$creadPrec :: ReadPrec SetPermission
readList :: ReadS [SetPermission]
$creadList :: ReadS [SetPermission]
readsPrec :: Int -> ReadS SetPermission
$creadsPrec :: Int -> ReadS SetPermission
Prelude.Read, Int -> SetPermission -> ShowS
[SetPermission] -> ShowS
SetPermission -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetPermission] -> ShowS
$cshowList :: [SetPermission] -> ShowS
show :: SetPermission -> String
$cshow :: SetPermission -> String
showsPrec :: Int -> SetPermission -> ShowS
$cshowsPrec :: Int -> SetPermission -> ShowS
Prelude.Show, forall x. Rep SetPermission x -> SetPermission
forall x. SetPermission -> Rep SetPermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetPermission x -> SetPermission
$cfrom :: forall x. SetPermission -> Rep SetPermission x
Prelude.Generic)

-- |
-- Create a value of 'SetPermission' 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:
--
-- 'allowSsh', 'setPermission_allowSsh' - The user is allowed to use SSH to communicate with the instance.
--
-- 'allowSudo', 'setPermission_allowSudo' - The user is allowed to use __sudo__ to elevate privileges.
--
-- 'level', 'setPermission_level' - The user\'s permission level, which must be set to one of the following
-- strings. You cannot set your own permissions level.
--
-- -   @deny@
--
-- -   @show@
--
-- -   @deploy@
--
-- -   @manage@
--
-- -   @iam_only@
--
-- For more information about the permissions associated with these levels,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
--
-- 'stackId', 'setPermission_stackId' - The stack ID.
--
-- 'iamUserArn', 'setPermission_iamUserArn' - The user\'s IAM ARN. This can also be a federated user\'s ARN.
newSetPermission ::
  -- | 'stackId'
  Prelude.Text ->
  -- | 'iamUserArn'
  Prelude.Text ->
  SetPermission
newSetPermission :: Text -> Text -> SetPermission
newSetPermission Text
pStackId_ Text
pIamUserArn_ =
  SetPermission'
    { $sel:allowSsh:SetPermission' :: Maybe Bool
allowSsh = forall a. Maybe a
Prelude.Nothing,
      $sel:allowSudo:SetPermission' :: Maybe Bool
allowSudo = forall a. Maybe a
Prelude.Nothing,
      $sel:level:SetPermission' :: Maybe Text
level = forall a. Maybe a
Prelude.Nothing,
      $sel:stackId:SetPermission' :: Text
stackId = Text
pStackId_,
      $sel:iamUserArn:SetPermission' :: Text
iamUserArn = Text
pIamUserArn_
    }

-- | The user is allowed to use SSH to communicate with the instance.
setPermission_allowSsh :: Lens.Lens' SetPermission (Prelude.Maybe Prelude.Bool)
setPermission_allowSsh :: Lens' SetPermission (Maybe Bool)
setPermission_allowSsh = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPermission' {Maybe Bool
allowSsh :: Maybe Bool
$sel:allowSsh:SetPermission' :: SetPermission -> Maybe Bool
allowSsh} -> Maybe Bool
allowSsh) (\s :: SetPermission
s@SetPermission' {} Maybe Bool
a -> SetPermission
s {$sel:allowSsh:SetPermission' :: Maybe Bool
allowSsh = Maybe Bool
a} :: SetPermission)

-- | The user is allowed to use __sudo__ to elevate privileges.
setPermission_allowSudo :: Lens.Lens' SetPermission (Prelude.Maybe Prelude.Bool)
setPermission_allowSudo :: Lens' SetPermission (Maybe Bool)
setPermission_allowSudo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPermission' {Maybe Bool
allowSudo :: Maybe Bool
$sel:allowSudo:SetPermission' :: SetPermission -> Maybe Bool
allowSudo} -> Maybe Bool
allowSudo) (\s :: SetPermission
s@SetPermission' {} Maybe Bool
a -> SetPermission
s {$sel:allowSudo:SetPermission' :: Maybe Bool
allowSudo = Maybe Bool
a} :: SetPermission)

-- | The user\'s permission level, which must be set to one of the following
-- strings. You cannot set your own permissions level.
--
-- -   @deny@
--
-- -   @show@
--
-- -   @deploy@
--
-- -   @manage@
--
-- -   @iam_only@
--
-- For more information about the permissions associated with these levels,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
setPermission_level :: Lens.Lens' SetPermission (Prelude.Maybe Prelude.Text)
setPermission_level :: Lens' SetPermission (Maybe Text)
setPermission_level = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPermission' {Maybe Text
level :: Maybe Text
$sel:level:SetPermission' :: SetPermission -> Maybe Text
level} -> Maybe Text
level) (\s :: SetPermission
s@SetPermission' {} Maybe Text
a -> SetPermission
s {$sel:level:SetPermission' :: Maybe Text
level = Maybe Text
a} :: SetPermission)

-- | The stack ID.
setPermission_stackId :: Lens.Lens' SetPermission Prelude.Text
setPermission_stackId :: Lens' SetPermission Text
setPermission_stackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPermission' {Text
stackId :: Text
$sel:stackId:SetPermission' :: SetPermission -> Text
stackId} -> Text
stackId) (\s :: SetPermission
s@SetPermission' {} Text
a -> SetPermission
s {$sel:stackId:SetPermission' :: Text
stackId = Text
a} :: SetPermission)

-- | The user\'s IAM ARN. This can also be a federated user\'s ARN.
setPermission_iamUserArn :: Lens.Lens' SetPermission Prelude.Text
setPermission_iamUserArn :: Lens' SetPermission Text
setPermission_iamUserArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetPermission' {Text
iamUserArn :: Text
$sel:iamUserArn:SetPermission' :: SetPermission -> Text
iamUserArn} -> Text
iamUserArn) (\s :: SetPermission
s@SetPermission' {} Text
a -> SetPermission
s {$sel:iamUserArn:SetPermission' :: Text
iamUserArn = Text
a} :: SetPermission)

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

instance Prelude.Hashable SetPermission where
  hashWithSalt :: Int -> SetPermission -> Int
hashWithSalt Int
_salt SetPermission' {Maybe Bool
Maybe Text
Text
iamUserArn :: Text
stackId :: Text
level :: Maybe Text
allowSudo :: Maybe Bool
allowSsh :: Maybe Bool
$sel:iamUserArn:SetPermission' :: SetPermission -> Text
$sel:stackId:SetPermission' :: SetPermission -> Text
$sel:level:SetPermission' :: SetPermission -> Maybe Text
$sel:allowSudo:SetPermission' :: SetPermission -> Maybe Bool
$sel:allowSsh:SetPermission' :: SetPermission -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allowSsh
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allowSudo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
level
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
iamUserArn

instance Prelude.NFData SetPermission where
  rnf :: SetPermission -> ()
rnf SetPermission' {Maybe Bool
Maybe Text
Text
iamUserArn :: Text
stackId :: Text
level :: Maybe Text
allowSudo :: Maybe Bool
allowSsh :: Maybe Bool
$sel:iamUserArn:SetPermission' :: SetPermission -> Text
$sel:stackId:SetPermission' :: SetPermission -> Text
$sel:level:SetPermission' :: SetPermission -> Maybe Text
$sel:allowSudo:SetPermission' :: SetPermission -> Maybe Bool
$sel:allowSsh:SetPermission' :: SetPermission -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allowSsh
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allowSudo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
level
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
iamUserArn

instance Data.ToHeaders SetPermission where
  toHeaders :: SetPermission -> [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
"OpsWorks_20130218.SetPermission" ::
                          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 SetPermission where
  toJSON :: SetPermission -> Value
toJSON SetPermission' {Maybe Bool
Maybe Text
Text
iamUserArn :: Text
stackId :: Text
level :: Maybe Text
allowSudo :: Maybe Bool
allowSsh :: Maybe Bool
$sel:iamUserArn:SetPermission' :: SetPermission -> Text
$sel:stackId:SetPermission' :: SetPermission -> Text
$sel:level:SetPermission' :: SetPermission -> Maybe Text
$sel:allowSudo:SetPermission' :: SetPermission -> Maybe Bool
$sel:allowSsh:SetPermission' :: SetPermission -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AllowSsh" 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 Bool
allowSsh,
            (Key
"AllowSudo" 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 Bool
allowSudo,
            (Key
"Level" 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 Text
level,
            forall a. a -> Maybe a
Prelude.Just (Key
"StackId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stackId),
            forall a. a -> Maybe a
Prelude.Just (Key
"IamUserArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
iamUserArn)
          ]
      )

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

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

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

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

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