module Stratosphere.ManagedBlockchain.Member.MemberFabricConfigurationProperty (
        MemberFabricConfigurationProperty(..),
        mkMemberFabricConfigurationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data MemberFabricConfigurationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-managedblockchain-member-memberfabricconfiguration.html>
    MemberFabricConfigurationProperty {MemberFabricConfigurationProperty -> ()
haddock_workaround_ :: (),
                                       -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-managedblockchain-member-memberfabricconfiguration.html#cfn-managedblockchain-member-memberfabricconfiguration-adminpassword>
                                       MemberFabricConfigurationProperty -> Value Text
adminPassword :: (Value Prelude.Text),
                                       -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-managedblockchain-member-memberfabricconfiguration.html#cfn-managedblockchain-member-memberfabricconfiguration-adminusername>
                                       MemberFabricConfigurationProperty -> Value Text
adminUsername :: (Value Prelude.Text)}
  deriving stock (MemberFabricConfigurationProperty
-> MemberFabricConfigurationProperty -> Bool
(MemberFabricConfigurationProperty
 -> MemberFabricConfigurationProperty -> Bool)
-> (MemberFabricConfigurationProperty
    -> MemberFabricConfigurationProperty -> Bool)
-> Eq MemberFabricConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemberFabricConfigurationProperty
-> MemberFabricConfigurationProperty -> Bool
== :: MemberFabricConfigurationProperty
-> MemberFabricConfigurationProperty -> Bool
$c/= :: MemberFabricConfigurationProperty
-> MemberFabricConfigurationProperty -> Bool
/= :: MemberFabricConfigurationProperty
-> MemberFabricConfigurationProperty -> Bool
Prelude.Eq, Int -> MemberFabricConfigurationProperty -> ShowS
[MemberFabricConfigurationProperty] -> ShowS
MemberFabricConfigurationProperty -> String
(Int -> MemberFabricConfigurationProperty -> ShowS)
-> (MemberFabricConfigurationProperty -> String)
-> ([MemberFabricConfigurationProperty] -> ShowS)
-> Show MemberFabricConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemberFabricConfigurationProperty -> ShowS
showsPrec :: Int -> MemberFabricConfigurationProperty -> ShowS
$cshow :: MemberFabricConfigurationProperty -> String
show :: MemberFabricConfigurationProperty -> String
$cshowList :: [MemberFabricConfigurationProperty] -> ShowS
showList :: [MemberFabricConfigurationProperty] -> ShowS
Prelude.Show)
mkMemberFabricConfigurationProperty ::
  Value Prelude.Text
  -> Value Prelude.Text -> MemberFabricConfigurationProperty
mkMemberFabricConfigurationProperty :: Value Text -> Value Text -> MemberFabricConfigurationProperty
mkMemberFabricConfigurationProperty Value Text
adminPassword Value Text
adminUsername
  = MemberFabricConfigurationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), adminPassword :: Value Text
adminPassword = Value Text
adminPassword,
       adminUsername :: Value Text
adminUsername = Value Text
adminUsername}
instance ToResourceProperties MemberFabricConfigurationProperty where
  toResourceProperties :: MemberFabricConfigurationProperty -> ResourceProperties
toResourceProperties MemberFabricConfigurationProperty {()
Value Text
haddock_workaround_ :: MemberFabricConfigurationProperty -> ()
adminPassword :: MemberFabricConfigurationProperty -> Value Text
adminUsername :: MemberFabricConfigurationProperty -> Value Text
haddock_workaround_ :: ()
adminPassword :: Value Text
adminUsername :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::ManagedBlockchain::Member.MemberFabricConfiguration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"AdminPassword" 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
adminPassword,
                       Key
"AdminUsername" 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
adminUsername]}
instance JSON.ToJSON MemberFabricConfigurationProperty where
  toJSON :: MemberFabricConfigurationProperty -> Value
toJSON MemberFabricConfigurationProperty {()
Value Text
haddock_workaround_ :: MemberFabricConfigurationProperty -> ()
adminPassword :: MemberFabricConfigurationProperty -> Value Text
adminUsername :: MemberFabricConfigurationProperty -> Value Text
haddock_workaround_ :: ()
adminPassword :: Value Text
adminUsername :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"AdminPassword" 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
adminPassword,
         Key
"AdminUsername" 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
adminUsername]
instance Property "AdminPassword" MemberFabricConfigurationProperty where
  type PropertyType "AdminPassword" MemberFabricConfigurationProperty = Value Prelude.Text
  set :: PropertyType "AdminPassword" MemberFabricConfigurationProperty
-> MemberFabricConfigurationProperty
-> MemberFabricConfigurationProperty
set PropertyType "AdminPassword" MemberFabricConfigurationProperty
newValue MemberFabricConfigurationProperty {()
Value Text
haddock_workaround_ :: MemberFabricConfigurationProperty -> ()
adminPassword :: MemberFabricConfigurationProperty -> Value Text
adminUsername :: MemberFabricConfigurationProperty -> Value Text
haddock_workaround_ :: ()
adminPassword :: Value Text
adminUsername :: Value Text
..}
    = MemberFabricConfigurationProperty {adminPassword :: Value Text
adminPassword = PropertyType "AdminPassword" MemberFabricConfigurationProperty
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
adminUsername :: Value Text
haddock_workaround_ :: ()
adminUsername :: Value Text
..}
instance Property "AdminUsername" MemberFabricConfigurationProperty where
  type PropertyType "AdminUsername" MemberFabricConfigurationProperty = Value Prelude.Text
  set :: PropertyType "AdminUsername" MemberFabricConfigurationProperty
-> MemberFabricConfigurationProperty
-> MemberFabricConfigurationProperty
set PropertyType "AdminUsername" MemberFabricConfigurationProperty
newValue MemberFabricConfigurationProperty {()
Value Text
haddock_workaround_ :: MemberFabricConfigurationProperty -> ()
adminPassword :: MemberFabricConfigurationProperty -> Value Text
adminUsername :: MemberFabricConfigurationProperty -> Value Text
haddock_workaround_ :: ()
adminPassword :: Value Text
adminUsername :: Value Text
..}
    = MemberFabricConfigurationProperty {adminUsername :: Value Text
adminUsername = PropertyType "AdminUsername" MemberFabricConfigurationProperty
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
adminPassword :: Value Text
haddock_workaround_ :: ()
adminPassword :: Value Text
..}