{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Grafana.Types.UpdateInstruction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Grafana.Types.UpdateInstruction where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Grafana.Types.Role
import Amazonka.Grafana.Types.UpdateAction
import Amazonka.Grafana.Types.User
import qualified Amazonka.Prelude as Prelude

-- | Contains the instructions for one Grafana role permission update in a
-- <https://docs.aws.amazon.com/grafana/latest/APIReference/API_UpdatePermissions.html UpdatePermissions>
-- operation.
--
-- /See:/ 'newUpdateInstruction' smart constructor.
data UpdateInstruction = UpdateInstruction'
  { -- | Specifies whether this update is to add or revoke role permissions.
    UpdateInstruction -> UpdateAction
action :: UpdateAction,
    -- | The role to add or revoke for the user or the group specified in
    -- @users@.
    UpdateInstruction -> Role
role' :: Role,
    -- | A structure that specifies the user or group to add or revoke the role
    -- for.
    UpdateInstruction -> [User]
users :: [User]
  }
  deriving (UpdateInstruction -> UpdateInstruction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateInstruction -> UpdateInstruction -> Bool
$c/= :: UpdateInstruction -> UpdateInstruction -> Bool
== :: UpdateInstruction -> UpdateInstruction -> Bool
$c== :: UpdateInstruction -> UpdateInstruction -> Bool
Prelude.Eq, ReadPrec [UpdateInstruction]
ReadPrec UpdateInstruction
Int -> ReadS UpdateInstruction
ReadS [UpdateInstruction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateInstruction]
$creadListPrec :: ReadPrec [UpdateInstruction]
readPrec :: ReadPrec UpdateInstruction
$creadPrec :: ReadPrec UpdateInstruction
readList :: ReadS [UpdateInstruction]
$creadList :: ReadS [UpdateInstruction]
readsPrec :: Int -> ReadS UpdateInstruction
$creadsPrec :: Int -> ReadS UpdateInstruction
Prelude.Read, Int -> UpdateInstruction -> ShowS
[UpdateInstruction] -> ShowS
UpdateInstruction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateInstruction] -> ShowS
$cshowList :: [UpdateInstruction] -> ShowS
show :: UpdateInstruction -> String
$cshow :: UpdateInstruction -> String
showsPrec :: Int -> UpdateInstruction -> ShowS
$cshowsPrec :: Int -> UpdateInstruction -> ShowS
Prelude.Show, forall x. Rep UpdateInstruction x -> UpdateInstruction
forall x. UpdateInstruction -> Rep UpdateInstruction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateInstruction x -> UpdateInstruction
$cfrom :: forall x. UpdateInstruction -> Rep UpdateInstruction x
Prelude.Generic)

-- |
-- Create a value of 'UpdateInstruction' 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:
--
-- 'action', 'updateInstruction_action' - Specifies whether this update is to add or revoke role permissions.
--
-- 'role'', 'updateInstruction_role' - The role to add or revoke for the user or the group specified in
-- @users@.
--
-- 'users', 'updateInstruction_users' - A structure that specifies the user or group to add or revoke the role
-- for.
newUpdateInstruction ::
  -- | 'action'
  UpdateAction ->
  -- | 'role''
  Role ->
  UpdateInstruction
newUpdateInstruction :: UpdateAction -> Role -> UpdateInstruction
newUpdateInstruction UpdateAction
pAction_ Role
pRole_ =
  UpdateInstruction'
    { $sel:action:UpdateInstruction' :: UpdateAction
action = UpdateAction
pAction_,
      $sel:role':UpdateInstruction' :: Role
role' = Role
pRole_,
      $sel:users:UpdateInstruction' :: [User]
users = forall a. Monoid a => a
Prelude.mempty
    }

-- | Specifies whether this update is to add or revoke role permissions.
updateInstruction_action :: Lens.Lens' UpdateInstruction UpdateAction
updateInstruction_action :: Lens' UpdateInstruction UpdateAction
updateInstruction_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstruction' {UpdateAction
action :: UpdateAction
$sel:action:UpdateInstruction' :: UpdateInstruction -> UpdateAction
action} -> UpdateAction
action) (\s :: UpdateInstruction
s@UpdateInstruction' {} UpdateAction
a -> UpdateInstruction
s {$sel:action:UpdateInstruction' :: UpdateAction
action = UpdateAction
a} :: UpdateInstruction)

-- | The role to add or revoke for the user or the group specified in
-- @users@.
updateInstruction_role :: Lens.Lens' UpdateInstruction Role
updateInstruction_role :: Lens' UpdateInstruction Role
updateInstruction_role = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstruction' {Role
role' :: Role
$sel:role':UpdateInstruction' :: UpdateInstruction -> Role
role'} -> Role
role') (\s :: UpdateInstruction
s@UpdateInstruction' {} Role
a -> UpdateInstruction
s {$sel:role':UpdateInstruction' :: Role
role' = Role
a} :: UpdateInstruction)

-- | A structure that specifies the user or group to add or revoke the role
-- for.
updateInstruction_users :: Lens.Lens' UpdateInstruction [User]
updateInstruction_users :: Lens' UpdateInstruction [User]
updateInstruction_users = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstruction' {[User]
users :: [User]
$sel:users:UpdateInstruction' :: UpdateInstruction -> [User]
users} -> [User]
users) (\s :: UpdateInstruction
s@UpdateInstruction' {} [User]
a -> UpdateInstruction
s {$sel:users:UpdateInstruction' :: [User]
users = [User]
a} :: UpdateInstruction) 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

instance Data.FromJSON UpdateInstruction where
  parseJSON :: Value -> Parser UpdateInstruction
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"UpdateInstruction"
      ( \Object
x ->
          UpdateAction -> Role -> [User] -> UpdateInstruction
UpdateInstruction'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"action")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"role")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"users" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable UpdateInstruction where
  hashWithSalt :: Int -> UpdateInstruction -> Int
hashWithSalt Int
_salt UpdateInstruction' {[User]
Role
UpdateAction
users :: [User]
role' :: Role
action :: UpdateAction
$sel:users:UpdateInstruction' :: UpdateInstruction -> [User]
$sel:role':UpdateInstruction' :: UpdateInstruction -> Role
$sel:action:UpdateInstruction' :: UpdateInstruction -> UpdateAction
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UpdateAction
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Role
role'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [User]
users

instance Prelude.NFData UpdateInstruction where
  rnf :: UpdateInstruction -> ()
rnf UpdateInstruction' {[User]
Role
UpdateAction
users :: [User]
role' :: Role
action :: UpdateAction
$sel:users:UpdateInstruction' :: UpdateInstruction -> [User]
$sel:role':UpdateInstruction' :: UpdateInstruction -> Role
$sel:action:UpdateInstruction' :: UpdateInstruction -> UpdateAction
..} =
    forall a. NFData a => a -> ()
Prelude.rnf UpdateAction
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Role
role'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [User]
users

instance Data.ToJSON UpdateInstruction where
  toJSON :: UpdateInstruction -> Value
toJSON UpdateInstruction' {[User]
Role
UpdateAction
users :: [User]
role' :: Role
action :: UpdateAction
$sel:users:UpdateInstruction' :: UpdateInstruction -> [User]
$sel:role':UpdateInstruction' :: UpdateInstruction -> Role
$sel:action:UpdateInstruction' :: UpdateInstruction -> UpdateAction
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"action" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UpdateAction
action),
            forall a. a -> Maybe a
Prelude.Just (Key
"role" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Role
role'),
            forall a. a -> Maybe a
Prelude.Just (Key
"users" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [User]
users)
          ]
      )