{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.MGN.PutTemplateAction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Put template post migration custom action.
module Amazonka.MGN.PutTemplateAction
  ( -- * Creating a Request
    PutTemplateAction (..),
    newPutTemplateAction,

    -- * Request Lenses
    putTemplateAction_active,
    putTemplateAction_documentVersion,
    putTemplateAction_mustSucceedForCutover,
    putTemplateAction_operatingSystem,
    putTemplateAction_parameters,
    putTemplateAction_timeoutSeconds,
    putTemplateAction_actionID,
    putTemplateAction_actionName,
    putTemplateAction_documentIdentifier,
    putTemplateAction_launchConfigurationTemplateID,
    putTemplateAction_order,

    -- * Destructuring the Response
    TemplateActionDocument (..),
    newTemplateActionDocument,

    -- * Response Lenses
    templateActionDocument_actionID,
    templateActionDocument_actionName,
    templateActionDocument_active,
    templateActionDocument_documentIdentifier,
    templateActionDocument_documentVersion,
    templateActionDocument_mustSucceedForCutover,
    templateActionDocument_operatingSystem,
    templateActionDocument_order,
    templateActionDocument_parameters,
    templateActionDocument_timeoutSeconds,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MGN.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newPutTemplateAction' smart constructor.
data PutTemplateAction = PutTemplateAction'
  { -- | Template post migration custom action active status.
    PutTemplateAction -> Maybe Bool
active :: Prelude.Maybe Prelude.Bool,
    -- | Template post migration custom action document version.
    PutTemplateAction -> Maybe Text
documentVersion :: Prelude.Maybe Prelude.Text,
    -- | Template post migration custom action must succeed for cutover.
    PutTemplateAction -> Maybe Bool
mustSucceedForCutover :: Prelude.Maybe Prelude.Bool,
    -- | Operating system eligible for this template post migration custom
    -- action.
    PutTemplateAction -> Maybe Text
operatingSystem :: Prelude.Maybe Prelude.Text,
    -- | Template post migration custom action parameters.
    PutTemplateAction
-> Maybe (HashMap Text [SsmParameterStoreParameter])
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text [SsmParameterStoreParameter]),
    -- | Template post migration custom action timeout in seconds.
    PutTemplateAction -> Maybe Natural
timeoutSeconds :: Prelude.Maybe Prelude.Natural,
    -- | Template post migration custom action ID.
    PutTemplateAction -> Text
actionID :: Prelude.Text,
    -- | Template post migration custom action name.
    PutTemplateAction -> Text
actionName :: Prelude.Text,
    -- | Template post migration custom action document identifier.
    PutTemplateAction -> Text
documentIdentifier :: Prelude.Text,
    -- | Launch configuration template ID.
    PutTemplateAction -> Text
launchConfigurationTemplateID :: Prelude.Text,
    -- | Template post migration custom action order.
    PutTemplateAction -> Natural
order :: Prelude.Natural
  }
  deriving (PutTemplateAction -> PutTemplateAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutTemplateAction -> PutTemplateAction -> Bool
$c/= :: PutTemplateAction -> PutTemplateAction -> Bool
== :: PutTemplateAction -> PutTemplateAction -> Bool
$c== :: PutTemplateAction -> PutTemplateAction -> Bool
Prelude.Eq, ReadPrec [PutTemplateAction]
ReadPrec PutTemplateAction
Int -> ReadS PutTemplateAction
ReadS [PutTemplateAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutTemplateAction]
$creadListPrec :: ReadPrec [PutTemplateAction]
readPrec :: ReadPrec PutTemplateAction
$creadPrec :: ReadPrec PutTemplateAction
readList :: ReadS [PutTemplateAction]
$creadList :: ReadS [PutTemplateAction]
readsPrec :: Int -> ReadS PutTemplateAction
$creadsPrec :: Int -> ReadS PutTemplateAction
Prelude.Read, Int -> PutTemplateAction -> ShowS
[PutTemplateAction] -> ShowS
PutTemplateAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutTemplateAction] -> ShowS
$cshowList :: [PutTemplateAction] -> ShowS
show :: PutTemplateAction -> String
$cshow :: PutTemplateAction -> String
showsPrec :: Int -> PutTemplateAction -> ShowS
$cshowsPrec :: Int -> PutTemplateAction -> ShowS
Prelude.Show, forall x. Rep PutTemplateAction x -> PutTemplateAction
forall x. PutTemplateAction -> Rep PutTemplateAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutTemplateAction x -> PutTemplateAction
$cfrom :: forall x. PutTemplateAction -> Rep PutTemplateAction x
Prelude.Generic)

-- |
-- Create a value of 'PutTemplateAction' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'active', 'putTemplateAction_active' - Template post migration custom action active status.
--
-- 'documentVersion', 'putTemplateAction_documentVersion' - Template post migration custom action document version.
--
-- 'mustSucceedForCutover', 'putTemplateAction_mustSucceedForCutover' - Template post migration custom action must succeed for cutover.
--
-- 'operatingSystem', 'putTemplateAction_operatingSystem' - Operating system eligible for this template post migration custom
-- action.
--
-- 'parameters', 'putTemplateAction_parameters' - Template post migration custom action parameters.
--
-- 'timeoutSeconds', 'putTemplateAction_timeoutSeconds' - Template post migration custom action timeout in seconds.
--
-- 'actionID', 'putTemplateAction_actionID' - Template post migration custom action ID.
--
-- 'actionName', 'putTemplateAction_actionName' - Template post migration custom action name.
--
-- 'documentIdentifier', 'putTemplateAction_documentIdentifier' - Template post migration custom action document identifier.
--
-- 'launchConfigurationTemplateID', 'putTemplateAction_launchConfigurationTemplateID' - Launch configuration template ID.
--
-- 'order', 'putTemplateAction_order' - Template post migration custom action order.
newPutTemplateAction ::
  -- | 'actionID'
  Prelude.Text ->
  -- | 'actionName'
  Prelude.Text ->
  -- | 'documentIdentifier'
  Prelude.Text ->
  -- | 'launchConfigurationTemplateID'
  Prelude.Text ->
  -- | 'order'
  Prelude.Natural ->
  PutTemplateAction
newPutTemplateAction :: Text -> Text -> Text -> Text -> Natural -> PutTemplateAction
newPutTemplateAction
  Text
pActionID_
  Text
pActionName_
  Text
pDocumentIdentifier_
  Text
pLaunchConfigurationTemplateID_
  Natural
pOrder_ =
    PutTemplateAction'
      { $sel:active:PutTemplateAction' :: Maybe Bool
active = forall a. Maybe a
Prelude.Nothing,
        $sel:documentVersion:PutTemplateAction' :: Maybe Text
documentVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:mustSucceedForCutover:PutTemplateAction' :: Maybe Bool
mustSucceedForCutover = forall a. Maybe a
Prelude.Nothing,
        $sel:operatingSystem:PutTemplateAction' :: Maybe Text
operatingSystem = forall a. Maybe a
Prelude.Nothing,
        $sel:parameters:PutTemplateAction' :: Maybe (HashMap Text [SsmParameterStoreParameter])
parameters = forall a. Maybe a
Prelude.Nothing,
        $sel:timeoutSeconds:PutTemplateAction' :: Maybe Natural
timeoutSeconds = forall a. Maybe a
Prelude.Nothing,
        $sel:actionID:PutTemplateAction' :: Text
actionID = Text
pActionID_,
        $sel:actionName:PutTemplateAction' :: Text
actionName = Text
pActionName_,
        $sel:documentIdentifier:PutTemplateAction' :: Text
documentIdentifier = Text
pDocumentIdentifier_,
        $sel:launchConfigurationTemplateID:PutTemplateAction' :: Text
launchConfigurationTemplateID =
          Text
pLaunchConfigurationTemplateID_,
        $sel:order:PutTemplateAction' :: Natural
order = Natural
pOrder_
      }

-- | Template post migration custom action active status.
putTemplateAction_active :: Lens.Lens' PutTemplateAction (Prelude.Maybe Prelude.Bool)
putTemplateAction_active :: Lens' PutTemplateAction (Maybe Bool)
putTemplateAction_active = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTemplateAction' {Maybe Bool
active :: Maybe Bool
$sel:active:PutTemplateAction' :: PutTemplateAction -> Maybe Bool
active} -> Maybe Bool
active) (\s :: PutTemplateAction
s@PutTemplateAction' {} Maybe Bool
a -> PutTemplateAction
s {$sel:active:PutTemplateAction' :: Maybe Bool
active = Maybe Bool
a} :: PutTemplateAction)

-- | Template post migration custom action document version.
putTemplateAction_documentVersion :: Lens.Lens' PutTemplateAction (Prelude.Maybe Prelude.Text)
putTemplateAction_documentVersion :: Lens' PutTemplateAction (Maybe Text)
putTemplateAction_documentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTemplateAction' {Maybe Text
documentVersion :: Maybe Text
$sel:documentVersion:PutTemplateAction' :: PutTemplateAction -> Maybe Text
documentVersion} -> Maybe Text
documentVersion) (\s :: PutTemplateAction
s@PutTemplateAction' {} Maybe Text
a -> PutTemplateAction
s {$sel:documentVersion:PutTemplateAction' :: Maybe Text
documentVersion = Maybe Text
a} :: PutTemplateAction)

-- | Template post migration custom action must succeed for cutover.
putTemplateAction_mustSucceedForCutover :: Lens.Lens' PutTemplateAction (Prelude.Maybe Prelude.Bool)
putTemplateAction_mustSucceedForCutover :: Lens' PutTemplateAction (Maybe Bool)
putTemplateAction_mustSucceedForCutover = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTemplateAction' {Maybe Bool
mustSucceedForCutover :: Maybe Bool
$sel:mustSucceedForCutover:PutTemplateAction' :: PutTemplateAction -> Maybe Bool
mustSucceedForCutover} -> Maybe Bool
mustSucceedForCutover) (\s :: PutTemplateAction
s@PutTemplateAction' {} Maybe Bool
a -> PutTemplateAction
s {$sel:mustSucceedForCutover:PutTemplateAction' :: Maybe Bool
mustSucceedForCutover = Maybe Bool
a} :: PutTemplateAction)

-- | Operating system eligible for this template post migration custom
-- action.
putTemplateAction_operatingSystem :: Lens.Lens' PutTemplateAction (Prelude.Maybe Prelude.Text)
putTemplateAction_operatingSystem :: Lens' PutTemplateAction (Maybe Text)
putTemplateAction_operatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTemplateAction' {Maybe Text
operatingSystem :: Maybe Text
$sel:operatingSystem:PutTemplateAction' :: PutTemplateAction -> Maybe Text
operatingSystem} -> Maybe Text
operatingSystem) (\s :: PutTemplateAction
s@PutTemplateAction' {} Maybe Text
a -> PutTemplateAction
s {$sel:operatingSystem:PutTemplateAction' :: Maybe Text
operatingSystem = Maybe Text
a} :: PutTemplateAction)

-- | Template post migration custom action parameters.
putTemplateAction_parameters :: Lens.Lens' PutTemplateAction (Prelude.Maybe (Prelude.HashMap Prelude.Text [SsmParameterStoreParameter]))
putTemplateAction_parameters :: Lens'
  PutTemplateAction
  (Maybe (HashMap Text [SsmParameterStoreParameter]))
putTemplateAction_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTemplateAction' {Maybe (HashMap Text [SsmParameterStoreParameter])
parameters :: Maybe (HashMap Text [SsmParameterStoreParameter])
$sel:parameters:PutTemplateAction' :: PutTemplateAction
-> Maybe (HashMap Text [SsmParameterStoreParameter])
parameters} -> Maybe (HashMap Text [SsmParameterStoreParameter])
parameters) (\s :: PutTemplateAction
s@PutTemplateAction' {} Maybe (HashMap Text [SsmParameterStoreParameter])
a -> PutTemplateAction
s {$sel:parameters:PutTemplateAction' :: Maybe (HashMap Text [SsmParameterStoreParameter])
parameters = Maybe (HashMap Text [SsmParameterStoreParameter])
a} :: PutTemplateAction) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Template post migration custom action timeout in seconds.
putTemplateAction_timeoutSeconds :: Lens.Lens' PutTemplateAction (Prelude.Maybe Prelude.Natural)
putTemplateAction_timeoutSeconds :: Lens' PutTemplateAction (Maybe Natural)
putTemplateAction_timeoutSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTemplateAction' {Maybe Natural
timeoutSeconds :: Maybe Natural
$sel:timeoutSeconds:PutTemplateAction' :: PutTemplateAction -> Maybe Natural
timeoutSeconds} -> Maybe Natural
timeoutSeconds) (\s :: PutTemplateAction
s@PutTemplateAction' {} Maybe Natural
a -> PutTemplateAction
s {$sel:timeoutSeconds:PutTemplateAction' :: Maybe Natural
timeoutSeconds = Maybe Natural
a} :: PutTemplateAction)

-- | Template post migration custom action ID.
putTemplateAction_actionID :: Lens.Lens' PutTemplateAction Prelude.Text
putTemplateAction_actionID :: Lens' PutTemplateAction Text
putTemplateAction_actionID = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTemplateAction' {Text
actionID :: Text
$sel:actionID:PutTemplateAction' :: PutTemplateAction -> Text
actionID} -> Text
actionID) (\s :: PutTemplateAction
s@PutTemplateAction' {} Text
a -> PutTemplateAction
s {$sel:actionID:PutTemplateAction' :: Text
actionID = Text
a} :: PutTemplateAction)

-- | Template post migration custom action name.
putTemplateAction_actionName :: Lens.Lens' PutTemplateAction Prelude.Text
putTemplateAction_actionName :: Lens' PutTemplateAction Text
putTemplateAction_actionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTemplateAction' {Text
actionName :: Text
$sel:actionName:PutTemplateAction' :: PutTemplateAction -> Text
actionName} -> Text
actionName) (\s :: PutTemplateAction
s@PutTemplateAction' {} Text
a -> PutTemplateAction
s {$sel:actionName:PutTemplateAction' :: Text
actionName = Text
a} :: PutTemplateAction)

-- | Template post migration custom action document identifier.
putTemplateAction_documentIdentifier :: Lens.Lens' PutTemplateAction Prelude.Text
putTemplateAction_documentIdentifier :: Lens' PutTemplateAction Text
putTemplateAction_documentIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTemplateAction' {Text
documentIdentifier :: Text
$sel:documentIdentifier:PutTemplateAction' :: PutTemplateAction -> Text
documentIdentifier} -> Text
documentIdentifier) (\s :: PutTemplateAction
s@PutTemplateAction' {} Text
a -> PutTemplateAction
s {$sel:documentIdentifier:PutTemplateAction' :: Text
documentIdentifier = Text
a} :: PutTemplateAction)

-- | Launch configuration template ID.
putTemplateAction_launchConfigurationTemplateID :: Lens.Lens' PutTemplateAction Prelude.Text
putTemplateAction_launchConfigurationTemplateID :: Lens' PutTemplateAction Text
putTemplateAction_launchConfigurationTemplateID = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTemplateAction' {Text
launchConfigurationTemplateID :: Text
$sel:launchConfigurationTemplateID:PutTemplateAction' :: PutTemplateAction -> Text
launchConfigurationTemplateID} -> Text
launchConfigurationTemplateID) (\s :: PutTemplateAction
s@PutTemplateAction' {} Text
a -> PutTemplateAction
s {$sel:launchConfigurationTemplateID:PutTemplateAction' :: Text
launchConfigurationTemplateID = Text
a} :: PutTemplateAction)

-- | Template post migration custom action order.
putTemplateAction_order :: Lens.Lens' PutTemplateAction Prelude.Natural
putTemplateAction_order :: Lens' PutTemplateAction Natural
putTemplateAction_order = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTemplateAction' {Natural
order :: Natural
$sel:order:PutTemplateAction' :: PutTemplateAction -> Natural
order} -> Natural
order) (\s :: PutTemplateAction
s@PutTemplateAction' {} Natural
a -> PutTemplateAction
s {$sel:order:PutTemplateAction' :: Natural
order = Natural
a} :: PutTemplateAction)

instance Core.AWSRequest PutTemplateAction where
  type
    AWSResponse PutTemplateAction =
      TemplateActionDocument
  request :: (Service -> Service)
-> PutTemplateAction -> Request PutTemplateAction
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutTemplateAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutTemplateAction)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      (\Int
s ResponseHeaders
h Object
x -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable PutTemplateAction where
  hashWithSalt :: Int -> PutTemplateAction -> Int
hashWithSalt Int
_salt PutTemplateAction' {Natural
Maybe Bool
Maybe Natural
Maybe Text
Maybe (HashMap Text [SsmParameterStoreParameter])
Text
order :: Natural
launchConfigurationTemplateID :: Text
documentIdentifier :: Text
actionName :: Text
actionID :: Text
timeoutSeconds :: Maybe Natural
parameters :: Maybe (HashMap Text [SsmParameterStoreParameter])
operatingSystem :: Maybe Text
mustSucceedForCutover :: Maybe Bool
documentVersion :: Maybe Text
active :: Maybe Bool
$sel:order:PutTemplateAction' :: PutTemplateAction -> Natural
$sel:launchConfigurationTemplateID:PutTemplateAction' :: PutTemplateAction -> Text
$sel:documentIdentifier:PutTemplateAction' :: PutTemplateAction -> Text
$sel:actionName:PutTemplateAction' :: PutTemplateAction -> Text
$sel:actionID:PutTemplateAction' :: PutTemplateAction -> Text
$sel:timeoutSeconds:PutTemplateAction' :: PutTemplateAction -> Maybe Natural
$sel:parameters:PutTemplateAction' :: PutTemplateAction
-> Maybe (HashMap Text [SsmParameterStoreParameter])
$sel:operatingSystem:PutTemplateAction' :: PutTemplateAction -> Maybe Text
$sel:mustSucceedForCutover:PutTemplateAction' :: PutTemplateAction -> Maybe Bool
$sel:documentVersion:PutTemplateAction' :: PutTemplateAction -> Maybe Text
$sel:active:PutTemplateAction' :: PutTemplateAction -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
active
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
documentVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
mustSucceedForCutover
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
operatingSystem
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text [SsmParameterStoreParameter])
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timeoutSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
actionID
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
actionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
documentIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
launchConfigurationTemplateID
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
order

instance Prelude.NFData PutTemplateAction where
  rnf :: PutTemplateAction -> ()
rnf PutTemplateAction' {Natural
Maybe Bool
Maybe Natural
Maybe Text
Maybe (HashMap Text [SsmParameterStoreParameter])
Text
order :: Natural
launchConfigurationTemplateID :: Text
documentIdentifier :: Text
actionName :: Text
actionID :: Text
timeoutSeconds :: Maybe Natural
parameters :: Maybe (HashMap Text [SsmParameterStoreParameter])
operatingSystem :: Maybe Text
mustSucceedForCutover :: Maybe Bool
documentVersion :: Maybe Text
active :: Maybe Bool
$sel:order:PutTemplateAction' :: PutTemplateAction -> Natural
$sel:launchConfigurationTemplateID:PutTemplateAction' :: PutTemplateAction -> Text
$sel:documentIdentifier:PutTemplateAction' :: PutTemplateAction -> Text
$sel:actionName:PutTemplateAction' :: PutTemplateAction -> Text
$sel:actionID:PutTemplateAction' :: PutTemplateAction -> Text
$sel:timeoutSeconds:PutTemplateAction' :: PutTemplateAction -> Maybe Natural
$sel:parameters:PutTemplateAction' :: PutTemplateAction
-> Maybe (HashMap Text [SsmParameterStoreParameter])
$sel:operatingSystem:PutTemplateAction' :: PutTemplateAction -> Maybe Text
$sel:mustSucceedForCutover:PutTemplateAction' :: PutTemplateAction -> Maybe Bool
$sel:documentVersion:PutTemplateAction' :: PutTemplateAction -> Maybe Text
$sel:active:PutTemplateAction' :: PutTemplateAction -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
active
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
documentVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
mustSucceedForCutover
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
operatingSystem
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [SsmParameterStoreParameter])
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
timeoutSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
actionID
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
actionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
documentIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
launchConfigurationTemplateID
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
order

instance Data.ToHeaders PutTemplateAction where
  toHeaders :: PutTemplateAction -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutTemplateAction where
  toJSON :: PutTemplateAction -> Value
toJSON PutTemplateAction' {Natural
Maybe Bool
Maybe Natural
Maybe Text
Maybe (HashMap Text [SsmParameterStoreParameter])
Text
order :: Natural
launchConfigurationTemplateID :: Text
documentIdentifier :: Text
actionName :: Text
actionID :: Text
timeoutSeconds :: Maybe Natural
parameters :: Maybe (HashMap Text [SsmParameterStoreParameter])
operatingSystem :: Maybe Text
mustSucceedForCutover :: Maybe Bool
documentVersion :: Maybe Text
active :: Maybe Bool
$sel:order:PutTemplateAction' :: PutTemplateAction -> Natural
$sel:launchConfigurationTemplateID:PutTemplateAction' :: PutTemplateAction -> Text
$sel:documentIdentifier:PutTemplateAction' :: PutTemplateAction -> Text
$sel:actionName:PutTemplateAction' :: PutTemplateAction -> Text
$sel:actionID:PutTemplateAction' :: PutTemplateAction -> Text
$sel:timeoutSeconds:PutTemplateAction' :: PutTemplateAction -> Maybe Natural
$sel:parameters:PutTemplateAction' :: PutTemplateAction
-> Maybe (HashMap Text [SsmParameterStoreParameter])
$sel:operatingSystem:PutTemplateAction' :: PutTemplateAction -> Maybe Text
$sel:mustSucceedForCutover:PutTemplateAction' :: PutTemplateAction -> Maybe Bool
$sel:documentVersion:PutTemplateAction' :: PutTemplateAction -> Maybe Text
$sel:active:PutTemplateAction' :: PutTemplateAction -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"active" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
active,
            (Key
"documentVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
documentVersion,
            (Key
"mustSucceedForCutover" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
mustSucceedForCutover,
            (Key
"operatingSystem" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
operatingSystem,
            (Key
"parameters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text [SsmParameterStoreParameter])
parameters,
            (Key
"timeoutSeconds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
timeoutSeconds,
            forall a. a -> Maybe a
Prelude.Just (Key
"actionID" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
actionID),
            forall a. a -> Maybe a
Prelude.Just (Key
"actionName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
actionName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"documentIdentifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
documentIdentifier),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"launchConfigurationTemplateID"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
launchConfigurationTemplateID
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"order" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
order)
          ]
      )

instance Data.ToPath PutTemplateAction where
  toPath :: PutTemplateAction -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/PutTemplateAction"

instance Data.ToQuery PutTemplateAction where
  toQuery :: PutTemplateAction -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty