module Stratosphere.MSK.ClusterPolicy (
        ClusterPolicy(..), mkClusterPolicy
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data ClusterPolicy
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-msk-clusterpolicy.html>
    ClusterPolicy {ClusterPolicy -> ()
haddock_workaround_ :: (),
                   -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-msk-clusterpolicy.html#cfn-msk-clusterpolicy-clusterarn>
                   ClusterPolicy -> Value Text
clusterArn :: (Value Prelude.Text),
                   -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-msk-clusterpolicy.html#cfn-msk-clusterpolicy-policy>
                   ClusterPolicy -> Object
policy :: JSON.Object}
  deriving stock (ClusterPolicy -> ClusterPolicy -> Bool
(ClusterPolicy -> ClusterPolicy -> Bool)
-> (ClusterPolicy -> ClusterPolicy -> Bool) -> Eq ClusterPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClusterPolicy -> ClusterPolicy -> Bool
== :: ClusterPolicy -> ClusterPolicy -> Bool
$c/= :: ClusterPolicy -> ClusterPolicy -> Bool
/= :: ClusterPolicy -> ClusterPolicy -> Bool
Prelude.Eq, Int -> ClusterPolicy -> ShowS
[ClusterPolicy] -> ShowS
ClusterPolicy -> String
(Int -> ClusterPolicy -> ShowS)
-> (ClusterPolicy -> String)
-> ([ClusterPolicy] -> ShowS)
-> Show ClusterPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClusterPolicy -> ShowS
showsPrec :: Int -> ClusterPolicy -> ShowS
$cshow :: ClusterPolicy -> String
show :: ClusterPolicy -> String
$cshowList :: [ClusterPolicy] -> ShowS
showList :: [ClusterPolicy] -> ShowS
Prelude.Show)
mkClusterPolicy ::
  Value Prelude.Text -> JSON.Object -> ClusterPolicy
mkClusterPolicy :: Value Text -> Object -> ClusterPolicy
mkClusterPolicy Value Text
clusterArn Object
policy
  = ClusterPolicy
      {haddock_workaround_ :: ()
haddock_workaround_ = (), clusterArn :: Value Text
clusterArn = Value Text
clusterArn,
       policy :: Object
policy = Object
policy}
instance ToResourceProperties ClusterPolicy where
  toResourceProperties :: ClusterPolicy -> ResourceProperties
toResourceProperties ClusterPolicy {()
Object
Value Text
haddock_workaround_ :: ClusterPolicy -> ()
clusterArn :: ClusterPolicy -> Value Text
policy :: ClusterPolicy -> Object
haddock_workaround_ :: ()
clusterArn :: Value Text
policy :: Object
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::MSK::ClusterPolicy", supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"ClusterArn" 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
clusterArn,
                       Key
"Policy" Key -> Object -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Object
policy]}
instance JSON.ToJSON ClusterPolicy where
  toJSON :: ClusterPolicy -> Value
toJSON ClusterPolicy {()
Object
Value Text
haddock_workaround_ :: ClusterPolicy -> ()
clusterArn :: ClusterPolicy -> Value Text
policy :: ClusterPolicy -> Object
haddock_workaround_ :: ()
clusterArn :: Value Text
policy :: Object
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"ClusterArn" 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
clusterArn, Key
"Policy" Key -> Object -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Object
policy]
instance Property "ClusterArn" ClusterPolicy where
  type PropertyType "ClusterArn" ClusterPolicy = Value Prelude.Text
  set :: PropertyType "ClusterArn" ClusterPolicy
-> ClusterPolicy -> ClusterPolicy
set PropertyType "ClusterArn" ClusterPolicy
newValue ClusterPolicy {()
Object
Value Text
haddock_workaround_ :: ClusterPolicy -> ()
clusterArn :: ClusterPolicy -> Value Text
policy :: ClusterPolicy -> Object
haddock_workaround_ :: ()
clusterArn :: Value Text
policy :: Object
..}
    = ClusterPolicy {clusterArn :: Value Text
clusterArn = PropertyType "ClusterArn" ClusterPolicy
Value Text
newValue, ()
Object
haddock_workaround_ :: ()
policy :: Object
haddock_workaround_ :: ()
policy :: Object
..}
instance Property "Policy" ClusterPolicy where
  type PropertyType "Policy" ClusterPolicy = JSON.Object
  set :: PropertyType "Policy" ClusterPolicy
-> ClusterPolicy -> ClusterPolicy
set PropertyType "Policy" ClusterPolicy
newValue ClusterPolicy {()
Object
Value Text
haddock_workaround_ :: ClusterPolicy -> ()
clusterArn :: ClusterPolicy -> Value Text
policy :: ClusterPolicy -> Object
haddock_workaround_ :: ()
clusterArn :: Value Text
policy :: Object
..}
    = ClusterPolicy {policy :: Object
policy = Object
PropertyType "Policy" ClusterPolicy
newValue, ()
Value Text
haddock_workaround_ :: ()
clusterArn :: Value Text
haddock_workaround_ :: ()
clusterArn :: Value Text
..}