module Stratosphere.LicenseManager.License.BorrowConfigurationProperty (
        BorrowConfigurationProperty(..), mkBorrowConfigurationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data BorrowConfigurationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-licensemanager-license-borrowconfiguration.html>
    BorrowConfigurationProperty {BorrowConfigurationProperty -> ()
haddock_workaround_ :: (),
                                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-licensemanager-license-borrowconfiguration.html#cfn-licensemanager-license-borrowconfiguration-allowearlycheckin>
                                 BorrowConfigurationProperty -> Value Bool
allowEarlyCheckIn :: (Value Prelude.Bool),
                                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-licensemanager-license-borrowconfiguration.html#cfn-licensemanager-license-borrowconfiguration-maxtimetoliveinminutes>
                                 BorrowConfigurationProperty -> Value Integer
maxTimeToLiveInMinutes :: (Value Prelude.Integer)}
  deriving stock (BorrowConfigurationProperty -> BorrowConfigurationProperty -> Bool
(BorrowConfigurationProperty
 -> BorrowConfigurationProperty -> Bool)
-> (BorrowConfigurationProperty
    -> BorrowConfigurationProperty -> Bool)
-> Eq BorrowConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BorrowConfigurationProperty -> BorrowConfigurationProperty -> Bool
== :: BorrowConfigurationProperty -> BorrowConfigurationProperty -> Bool
$c/= :: BorrowConfigurationProperty -> BorrowConfigurationProperty -> Bool
/= :: BorrowConfigurationProperty -> BorrowConfigurationProperty -> Bool
Prelude.Eq, Int -> BorrowConfigurationProperty -> ShowS
[BorrowConfigurationProperty] -> ShowS
BorrowConfigurationProperty -> String
(Int -> BorrowConfigurationProperty -> ShowS)
-> (BorrowConfigurationProperty -> String)
-> ([BorrowConfigurationProperty] -> ShowS)
-> Show BorrowConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BorrowConfigurationProperty -> ShowS
showsPrec :: Int -> BorrowConfigurationProperty -> ShowS
$cshow :: BorrowConfigurationProperty -> String
show :: BorrowConfigurationProperty -> String
$cshowList :: [BorrowConfigurationProperty] -> ShowS
showList :: [BorrowConfigurationProperty] -> ShowS
Prelude.Show)
mkBorrowConfigurationProperty ::
  Value Prelude.Bool
  -> Value Prelude.Integer -> BorrowConfigurationProperty
mkBorrowConfigurationProperty :: Value Bool -> Value Integer -> BorrowConfigurationProperty
mkBorrowConfigurationProperty
  Value Bool
allowEarlyCheckIn
  Value Integer
maxTimeToLiveInMinutes
  = BorrowConfigurationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), allowEarlyCheckIn :: Value Bool
allowEarlyCheckIn = Value Bool
allowEarlyCheckIn,
       maxTimeToLiveInMinutes :: Value Integer
maxTimeToLiveInMinutes = Value Integer
maxTimeToLiveInMinutes}
instance ToResourceProperties BorrowConfigurationProperty where
  toResourceProperties :: BorrowConfigurationProperty -> ResourceProperties
toResourceProperties BorrowConfigurationProperty {()
Value Bool
Value Integer
haddock_workaround_ :: BorrowConfigurationProperty -> ()
allowEarlyCheckIn :: BorrowConfigurationProperty -> Value Bool
maxTimeToLiveInMinutes :: BorrowConfigurationProperty -> Value Integer
haddock_workaround_ :: ()
allowEarlyCheckIn :: Value Bool
maxTimeToLiveInMinutes :: Value Integer
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::LicenseManager::License.BorrowConfiguration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"AllowEarlyCheckIn" Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Bool
allowEarlyCheckIn,
                       Key
"MaxTimeToLiveInMinutes" Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Integer
maxTimeToLiveInMinutes]}
instance JSON.ToJSON BorrowConfigurationProperty where
  toJSON :: BorrowConfigurationProperty -> Value
toJSON BorrowConfigurationProperty {()
Value Bool
Value Integer
haddock_workaround_ :: BorrowConfigurationProperty -> ()
allowEarlyCheckIn :: BorrowConfigurationProperty -> Value Bool
maxTimeToLiveInMinutes :: BorrowConfigurationProperty -> Value Integer
haddock_workaround_ :: ()
allowEarlyCheckIn :: Value Bool
maxTimeToLiveInMinutes :: Value Integer
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"AllowEarlyCheckIn" Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Bool
allowEarlyCheckIn,
         Key
"MaxTimeToLiveInMinutes" Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Integer
maxTimeToLiveInMinutes]
instance Property "AllowEarlyCheckIn" BorrowConfigurationProperty where
  type PropertyType "AllowEarlyCheckIn" BorrowConfigurationProperty = Value Prelude.Bool
  set :: PropertyType "AllowEarlyCheckIn" BorrowConfigurationProperty
-> BorrowConfigurationProperty -> BorrowConfigurationProperty
set PropertyType "AllowEarlyCheckIn" BorrowConfigurationProperty
newValue BorrowConfigurationProperty {()
Value Bool
Value Integer
haddock_workaround_ :: BorrowConfigurationProperty -> ()
allowEarlyCheckIn :: BorrowConfigurationProperty -> Value Bool
maxTimeToLiveInMinutes :: BorrowConfigurationProperty -> Value Integer
haddock_workaround_ :: ()
allowEarlyCheckIn :: Value Bool
maxTimeToLiveInMinutes :: Value Integer
..}
    = BorrowConfigurationProperty {allowEarlyCheckIn :: Value Bool
allowEarlyCheckIn = PropertyType "AllowEarlyCheckIn" BorrowConfigurationProperty
Value Bool
newValue, ()
Value Integer
haddock_workaround_ :: ()
maxTimeToLiveInMinutes :: Value Integer
haddock_workaround_ :: ()
maxTimeToLiveInMinutes :: Value Integer
..}
instance Property "MaxTimeToLiveInMinutes" BorrowConfigurationProperty where
  type PropertyType "MaxTimeToLiveInMinutes" BorrowConfigurationProperty = Value Prelude.Integer
  set :: PropertyType "MaxTimeToLiveInMinutes" BorrowConfigurationProperty
-> BorrowConfigurationProperty -> BorrowConfigurationProperty
set PropertyType "MaxTimeToLiveInMinutes" BorrowConfigurationProperty
newValue BorrowConfigurationProperty {()
Value Bool
Value Integer
haddock_workaround_ :: BorrowConfigurationProperty -> ()
allowEarlyCheckIn :: BorrowConfigurationProperty -> Value Bool
maxTimeToLiveInMinutes :: BorrowConfigurationProperty -> Value Integer
haddock_workaround_ :: ()
allowEarlyCheckIn :: Value Bool
maxTimeToLiveInMinutes :: Value Integer
..}
    = BorrowConfigurationProperty
        {maxTimeToLiveInMinutes :: Value Integer
maxTimeToLiveInMinutes = PropertyType "MaxTimeToLiveInMinutes" BorrowConfigurationProperty
Value Integer
newValue, ()
Value Bool
haddock_workaround_ :: ()
allowEarlyCheckIn :: Value Bool
haddock_workaround_ :: ()
allowEarlyCheckIn :: Value Bool
..}