module Stratosphere.IAM.UserToGroupAddition (
        UserToGroupAddition(..), mkUserToGroupAddition
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data UserToGroupAddition
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iam-addusertogroup.html>
    UserToGroupAddition {UserToGroupAddition -> ()
haddock_workaround_ :: (),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iam-addusertogroup.html#cfn-iam-addusertogroup-groupname>
                         UserToGroupAddition -> Value Text
groupName :: (Value Prelude.Text),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iam-addusertogroup.html#cfn-iam-addusertogroup-users>
                         UserToGroupAddition -> ValueList Text
users :: (ValueList Prelude.Text)}
  deriving stock (UserToGroupAddition -> UserToGroupAddition -> Bool
(UserToGroupAddition -> UserToGroupAddition -> Bool)
-> (UserToGroupAddition -> UserToGroupAddition -> Bool)
-> Eq UserToGroupAddition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserToGroupAddition -> UserToGroupAddition -> Bool
== :: UserToGroupAddition -> UserToGroupAddition -> Bool
$c/= :: UserToGroupAddition -> UserToGroupAddition -> Bool
/= :: UserToGroupAddition -> UserToGroupAddition -> Bool
Prelude.Eq, Int -> UserToGroupAddition -> ShowS
[UserToGroupAddition] -> ShowS
UserToGroupAddition -> String
(Int -> UserToGroupAddition -> ShowS)
-> (UserToGroupAddition -> String)
-> ([UserToGroupAddition] -> ShowS)
-> Show UserToGroupAddition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserToGroupAddition -> ShowS
showsPrec :: Int -> UserToGroupAddition -> ShowS
$cshow :: UserToGroupAddition -> String
show :: UserToGroupAddition -> String
$cshowList :: [UserToGroupAddition] -> ShowS
showList :: [UserToGroupAddition] -> ShowS
Prelude.Show)
mkUserToGroupAddition ::
  Value Prelude.Text -> ValueList Prelude.Text -> UserToGroupAddition
mkUserToGroupAddition :: Value Text -> ValueList Text -> UserToGroupAddition
mkUserToGroupAddition Value Text
groupName ValueList Text
users
  = UserToGroupAddition
      {haddock_workaround_ :: ()
haddock_workaround_ = (), groupName :: Value Text
groupName = Value Text
groupName, users :: ValueList Text
users = ValueList Text
users}
instance ToResourceProperties UserToGroupAddition where
  toResourceProperties :: UserToGroupAddition -> ResourceProperties
toResourceProperties UserToGroupAddition {()
ValueList Text
Value Text
haddock_workaround_ :: UserToGroupAddition -> ()
groupName :: UserToGroupAddition -> Value Text
users :: UserToGroupAddition -> ValueList Text
haddock_workaround_ :: ()
groupName :: Value Text
users :: ValueList Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::IAM::UserToGroupAddition",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"GroupName" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
groupName,
                       Key
"Users" Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ValueList Text
users]}
instance JSON.ToJSON UserToGroupAddition where
  toJSON :: UserToGroupAddition -> Value
toJSON UserToGroupAddition {()
ValueList Text
Value Text
haddock_workaround_ :: UserToGroupAddition -> ()
groupName :: UserToGroupAddition -> Value Text
users :: UserToGroupAddition -> ValueList Text
haddock_workaround_ :: ()
groupName :: Value Text
users :: ValueList Text
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"GroupName" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
groupName, Key
"Users" Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ValueList Text
users]
instance Property "GroupName" UserToGroupAddition where
  type PropertyType "GroupName" UserToGroupAddition = Value Prelude.Text
  set :: PropertyType "GroupName" UserToGroupAddition
-> UserToGroupAddition -> UserToGroupAddition
set PropertyType "GroupName" UserToGroupAddition
newValue UserToGroupAddition {()
ValueList Text
Value Text
haddock_workaround_ :: UserToGroupAddition -> ()
groupName :: UserToGroupAddition -> Value Text
users :: UserToGroupAddition -> ValueList Text
haddock_workaround_ :: ()
groupName :: Value Text
users :: ValueList Text
..}
    = UserToGroupAddition {groupName :: Value Text
groupName = PropertyType "GroupName" UserToGroupAddition
Value Text
newValue, ()
ValueList Text
haddock_workaround_ :: ()
users :: ValueList Text
haddock_workaround_ :: ()
users :: ValueList Text
..}
instance Property "Users" UserToGroupAddition where
  type PropertyType "Users" UserToGroupAddition = ValueList Prelude.Text
  set :: PropertyType "Users" UserToGroupAddition
-> UserToGroupAddition -> UserToGroupAddition
set PropertyType "Users" UserToGroupAddition
newValue UserToGroupAddition {()
ValueList Text
Value Text
haddock_workaround_ :: UserToGroupAddition -> ()
groupName :: UserToGroupAddition -> Value Text
users :: UserToGroupAddition -> ValueList Text
haddock_workaround_ :: ()
groupName :: Value Text
users :: ValueList Text
..}
    = UserToGroupAddition {users :: ValueList Text
users = PropertyType "Users" UserToGroupAddition
ValueList Text
newValue, ()
Value Text
haddock_workaround_ :: ()
groupName :: Value Text
haddock_workaround_ :: ()
groupName :: Value Text
..}