module Stratosphere.Omics.Workflow.ContainerRegistryMapProperty (
        module Exports, ContainerRegistryMapProperty(..),
        mkContainerRegistryMapProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Omics.Workflow.ImageMappingProperty as Exports
import {-# SOURCE #-} Stratosphere.Omics.Workflow.RegistryMappingProperty as Exports
import Stratosphere.ResourceProperties
data ContainerRegistryMapProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-omics-workflow-containerregistrymap.html>
    ContainerRegistryMapProperty {ContainerRegistryMapProperty -> ()
haddock_workaround_ :: (),
                                  -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-omics-workflow-containerregistrymap.html#cfn-omics-workflow-containerregistrymap-imagemappings>
                                  ContainerRegistryMapProperty -> Maybe [ImageMappingProperty]
imageMappings :: (Prelude.Maybe [ImageMappingProperty]),
                                  -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-omics-workflow-containerregistrymap.html#cfn-omics-workflow-containerregistrymap-registrymappings>
                                  ContainerRegistryMapProperty -> Maybe [RegistryMappingProperty]
registryMappings :: (Prelude.Maybe [RegistryMappingProperty])}
  deriving stock (ContainerRegistryMapProperty
-> ContainerRegistryMapProperty -> Bool
(ContainerRegistryMapProperty
 -> ContainerRegistryMapProperty -> Bool)
-> (ContainerRegistryMapProperty
    -> ContainerRegistryMapProperty -> Bool)
-> Eq ContainerRegistryMapProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContainerRegistryMapProperty
-> ContainerRegistryMapProperty -> Bool
== :: ContainerRegistryMapProperty
-> ContainerRegistryMapProperty -> Bool
$c/= :: ContainerRegistryMapProperty
-> ContainerRegistryMapProperty -> Bool
/= :: ContainerRegistryMapProperty
-> ContainerRegistryMapProperty -> Bool
Prelude.Eq, Int -> ContainerRegistryMapProperty -> ShowS
[ContainerRegistryMapProperty] -> ShowS
ContainerRegistryMapProperty -> String
(Int -> ContainerRegistryMapProperty -> ShowS)
-> (ContainerRegistryMapProperty -> String)
-> ([ContainerRegistryMapProperty] -> ShowS)
-> Show ContainerRegistryMapProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContainerRegistryMapProperty -> ShowS
showsPrec :: Int -> ContainerRegistryMapProperty -> ShowS
$cshow :: ContainerRegistryMapProperty -> String
show :: ContainerRegistryMapProperty -> String
$cshowList :: [ContainerRegistryMapProperty] -> ShowS
showList :: [ContainerRegistryMapProperty] -> ShowS
Prelude.Show)
mkContainerRegistryMapProperty :: ContainerRegistryMapProperty
mkContainerRegistryMapProperty :: ContainerRegistryMapProperty
mkContainerRegistryMapProperty
  = ContainerRegistryMapProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), imageMappings :: Maybe [ImageMappingProperty]
imageMappings = Maybe [ImageMappingProperty]
forall a. Maybe a
Prelude.Nothing,
       registryMappings :: Maybe [RegistryMappingProperty]
registryMappings = Maybe [RegistryMappingProperty]
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties ContainerRegistryMapProperty where
  toResourceProperties :: ContainerRegistryMapProperty -> ResourceProperties
toResourceProperties ContainerRegistryMapProperty {Maybe [ImageMappingProperty]
Maybe [RegistryMappingProperty]
()
haddock_workaround_ :: ContainerRegistryMapProperty -> ()
imageMappings :: ContainerRegistryMapProperty -> Maybe [ImageMappingProperty]
registryMappings :: ContainerRegistryMapProperty -> Maybe [RegistryMappingProperty]
haddock_workaround_ :: ()
imageMappings :: Maybe [ImageMappingProperty]
registryMappings :: Maybe [RegistryMappingProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Omics::Workflow.ContainerRegistryMap",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                           [Key -> [ImageMappingProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ImageMappings" ([ImageMappingProperty] -> (Key, Value))
-> Maybe [ImageMappingProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [ImageMappingProperty]
imageMappings,
                            Key -> [RegistryMappingProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RegistryMappings" ([RegistryMappingProperty] -> (Key, Value))
-> Maybe [RegistryMappingProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [RegistryMappingProperty]
registryMappings])}
instance JSON.ToJSON ContainerRegistryMapProperty where
  toJSON :: ContainerRegistryMapProperty -> Value
toJSON ContainerRegistryMapProperty {Maybe [ImageMappingProperty]
Maybe [RegistryMappingProperty]
()
haddock_workaround_ :: ContainerRegistryMapProperty -> ()
imageMappings :: ContainerRegistryMapProperty -> Maybe [ImageMappingProperty]
registryMappings :: ContainerRegistryMapProperty -> Maybe [RegistryMappingProperty]
haddock_workaround_ :: ()
imageMappings :: Maybe [ImageMappingProperty]
registryMappings :: Maybe [RegistryMappingProperty]
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
              [Key -> [ImageMappingProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ImageMappings" ([ImageMappingProperty] -> (Key, Value))
-> Maybe [ImageMappingProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [ImageMappingProperty]
imageMappings,
               Key -> [RegistryMappingProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RegistryMappings" ([RegistryMappingProperty] -> (Key, Value))
-> Maybe [RegistryMappingProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [RegistryMappingProperty]
registryMappings]))
instance Property "ImageMappings" ContainerRegistryMapProperty where
  type PropertyType "ImageMappings" ContainerRegistryMapProperty = [ImageMappingProperty]
  set :: PropertyType "ImageMappings" ContainerRegistryMapProperty
-> ContainerRegistryMapProperty -> ContainerRegistryMapProperty
set PropertyType "ImageMappings" ContainerRegistryMapProperty
newValue ContainerRegistryMapProperty {Maybe [ImageMappingProperty]
Maybe [RegistryMappingProperty]
()
haddock_workaround_ :: ContainerRegistryMapProperty -> ()
imageMappings :: ContainerRegistryMapProperty -> Maybe [ImageMappingProperty]
registryMappings :: ContainerRegistryMapProperty -> Maybe [RegistryMappingProperty]
haddock_workaround_ :: ()
imageMappings :: Maybe [ImageMappingProperty]
registryMappings :: Maybe [RegistryMappingProperty]
..}
    = ContainerRegistryMapProperty
        {imageMappings :: Maybe [ImageMappingProperty]
imageMappings = [ImageMappingProperty] -> Maybe [ImageMappingProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [ImageMappingProperty]
PropertyType "ImageMappings" ContainerRegistryMapProperty
newValue, Maybe [RegistryMappingProperty]
()
haddock_workaround_ :: ()
registryMappings :: Maybe [RegistryMappingProperty]
haddock_workaround_ :: ()
registryMappings :: Maybe [RegistryMappingProperty]
..}
instance Property "RegistryMappings" ContainerRegistryMapProperty where
  type PropertyType "RegistryMappings" ContainerRegistryMapProperty = [RegistryMappingProperty]
  set :: PropertyType "RegistryMappings" ContainerRegistryMapProperty
-> ContainerRegistryMapProperty -> ContainerRegistryMapProperty
set PropertyType "RegistryMappings" ContainerRegistryMapProperty
newValue ContainerRegistryMapProperty {Maybe [ImageMappingProperty]
Maybe [RegistryMappingProperty]
()
haddock_workaround_ :: ContainerRegistryMapProperty -> ()
imageMappings :: ContainerRegistryMapProperty -> Maybe [ImageMappingProperty]
registryMappings :: ContainerRegistryMapProperty -> Maybe [RegistryMappingProperty]
haddock_workaround_ :: ()
imageMappings :: Maybe [ImageMappingProperty]
registryMappings :: Maybe [RegistryMappingProperty]
..}
    = ContainerRegistryMapProperty
        {registryMappings :: Maybe [RegistryMappingProperty]
registryMappings = [RegistryMappingProperty] -> Maybe [RegistryMappingProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [RegistryMappingProperty]
PropertyType "RegistryMappings" ContainerRegistryMapProperty
newValue, Maybe [ImageMappingProperty]
()
haddock_workaround_ :: ()
imageMappings :: Maybe [ImageMappingProperty]
haddock_workaround_ :: ()
imageMappings :: Maybe [ImageMappingProperty]
..}