{-# 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.StepFunctions.UpdateStateMachine
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing state machine by modifying its @definition@,
-- @roleArn@, or @loggingConfiguration@. Running executions will continue
-- to use the previous @definition@ and @roleArn@. You must include at
-- least one of @definition@ or @roleArn@ or you will receive a
-- @MissingRequiredParameter@ error.
--
-- If the given state machine Amazon Resource Name (ARN) is a qualified
-- state machine ARN, it will fail with ValidationException.
--
-- A qualified state machine ARN refers to a /Distributed Map state/
-- defined within a state machine. For example, the qualified state machine
-- ARN
-- @arn:partition:states:region:account-id:stateMachine:stateMachineName\/mapStateLabel@
-- refers to a /Distributed Map state/ with a label @mapStateLabel@ in the
-- state machine named @stateMachineName@.
--
-- All @StartExecution@ calls within a few seconds will use the updated
-- @definition@ and @roleArn@. Executions started immediately after calling
-- @UpdateStateMachine@ may use the previous state machine @definition@ and
-- @roleArn@.
module Amazonka.StepFunctions.UpdateStateMachine
  ( -- * Creating a Request
    UpdateStateMachine (..),
    newUpdateStateMachine,

    -- * Request Lenses
    updateStateMachine_definition,
    updateStateMachine_loggingConfiguration,
    updateStateMachine_roleArn,
    updateStateMachine_tracingConfiguration,
    updateStateMachine_stateMachineArn,

    -- * Destructuring the Response
    UpdateStateMachineResponse (..),
    newUpdateStateMachineResponse,

    -- * Response Lenses
    updateStateMachineResponse_httpStatus,
    updateStateMachineResponse_updateDate,
  )
where

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

-- | /See:/ 'newUpdateStateMachine' smart constructor.
data UpdateStateMachine = UpdateStateMachine'
  { -- | The Amazon States Language definition of the state machine. See
    -- <https://docs.aws.amazon.com/step-functions/latest/dg/concepts-amazon-states-language.html Amazon States Language>.
    UpdateStateMachine -> Maybe (Sensitive Text)
definition :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The @LoggingConfiguration@ data type is used to set CloudWatch Logs
    -- options.
    UpdateStateMachine -> Maybe LoggingConfiguration
loggingConfiguration :: Prelude.Maybe LoggingConfiguration,
    -- | The Amazon Resource Name (ARN) of the IAM role of the state machine.
    UpdateStateMachine -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | Selects whether X-Ray tracing is enabled.
    UpdateStateMachine -> Maybe TracingConfiguration
tracingConfiguration :: Prelude.Maybe TracingConfiguration,
    -- | The Amazon Resource Name (ARN) of the state machine.
    UpdateStateMachine -> Text
stateMachineArn :: Prelude.Text
  }
  deriving (UpdateStateMachine -> UpdateStateMachine -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStateMachine -> UpdateStateMachine -> Bool
$c/= :: UpdateStateMachine -> UpdateStateMachine -> Bool
== :: UpdateStateMachine -> UpdateStateMachine -> Bool
$c== :: UpdateStateMachine -> UpdateStateMachine -> Bool
Prelude.Eq, Int -> UpdateStateMachine -> ShowS
[UpdateStateMachine] -> ShowS
UpdateStateMachine -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStateMachine] -> ShowS
$cshowList :: [UpdateStateMachine] -> ShowS
show :: UpdateStateMachine -> String
$cshow :: UpdateStateMachine -> String
showsPrec :: Int -> UpdateStateMachine -> ShowS
$cshowsPrec :: Int -> UpdateStateMachine -> ShowS
Prelude.Show, forall x. Rep UpdateStateMachine x -> UpdateStateMachine
forall x. UpdateStateMachine -> Rep UpdateStateMachine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateStateMachine x -> UpdateStateMachine
$cfrom :: forall x. UpdateStateMachine -> Rep UpdateStateMachine x
Prelude.Generic)

-- |
-- Create a value of 'UpdateStateMachine' 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:
--
-- 'definition', 'updateStateMachine_definition' - The Amazon States Language definition of the state machine. See
-- <https://docs.aws.amazon.com/step-functions/latest/dg/concepts-amazon-states-language.html Amazon States Language>.
--
-- 'loggingConfiguration', 'updateStateMachine_loggingConfiguration' - The @LoggingConfiguration@ data type is used to set CloudWatch Logs
-- options.
--
-- 'roleArn', 'updateStateMachine_roleArn' - The Amazon Resource Name (ARN) of the IAM role of the state machine.
--
-- 'tracingConfiguration', 'updateStateMachine_tracingConfiguration' - Selects whether X-Ray tracing is enabled.
--
-- 'stateMachineArn', 'updateStateMachine_stateMachineArn' - The Amazon Resource Name (ARN) of the state machine.
newUpdateStateMachine ::
  -- | 'stateMachineArn'
  Prelude.Text ->
  UpdateStateMachine
newUpdateStateMachine :: Text -> UpdateStateMachine
newUpdateStateMachine Text
pStateMachineArn_ =
  UpdateStateMachine'
    { $sel:definition:UpdateStateMachine' :: Maybe (Sensitive Text)
definition = forall a. Maybe a
Prelude.Nothing,
      $sel:loggingConfiguration:UpdateStateMachine' :: Maybe LoggingConfiguration
loggingConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:UpdateStateMachine' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:tracingConfiguration:UpdateStateMachine' :: Maybe TracingConfiguration
tracingConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:stateMachineArn:UpdateStateMachine' :: Text
stateMachineArn = Text
pStateMachineArn_
    }

-- | The Amazon States Language definition of the state machine. See
-- <https://docs.aws.amazon.com/step-functions/latest/dg/concepts-amazon-states-language.html Amazon States Language>.
updateStateMachine_definition :: Lens.Lens' UpdateStateMachine (Prelude.Maybe Prelude.Text)
updateStateMachine_definition :: Lens' UpdateStateMachine (Maybe Text)
updateStateMachine_definition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStateMachine' {Maybe (Sensitive Text)
definition :: Maybe (Sensitive Text)
$sel:definition:UpdateStateMachine' :: UpdateStateMachine -> Maybe (Sensitive Text)
definition} -> Maybe (Sensitive Text)
definition) (\s :: UpdateStateMachine
s@UpdateStateMachine' {} Maybe (Sensitive Text)
a -> UpdateStateMachine
s {$sel:definition:UpdateStateMachine' :: Maybe (Sensitive Text)
definition = Maybe (Sensitive Text)
a} :: UpdateStateMachine) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The @LoggingConfiguration@ data type is used to set CloudWatch Logs
-- options.
updateStateMachine_loggingConfiguration :: Lens.Lens' UpdateStateMachine (Prelude.Maybe LoggingConfiguration)
updateStateMachine_loggingConfiguration :: Lens' UpdateStateMachine (Maybe LoggingConfiguration)
updateStateMachine_loggingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStateMachine' {Maybe LoggingConfiguration
loggingConfiguration :: Maybe LoggingConfiguration
$sel:loggingConfiguration:UpdateStateMachine' :: UpdateStateMachine -> Maybe LoggingConfiguration
loggingConfiguration} -> Maybe LoggingConfiguration
loggingConfiguration) (\s :: UpdateStateMachine
s@UpdateStateMachine' {} Maybe LoggingConfiguration
a -> UpdateStateMachine
s {$sel:loggingConfiguration:UpdateStateMachine' :: Maybe LoggingConfiguration
loggingConfiguration = Maybe LoggingConfiguration
a} :: UpdateStateMachine)

-- | The Amazon Resource Name (ARN) of the IAM role of the state machine.
updateStateMachine_roleArn :: Lens.Lens' UpdateStateMachine (Prelude.Maybe Prelude.Text)
updateStateMachine_roleArn :: Lens' UpdateStateMachine (Maybe Text)
updateStateMachine_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStateMachine' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:UpdateStateMachine' :: UpdateStateMachine -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: UpdateStateMachine
s@UpdateStateMachine' {} Maybe Text
a -> UpdateStateMachine
s {$sel:roleArn:UpdateStateMachine' :: Maybe Text
roleArn = Maybe Text
a} :: UpdateStateMachine)

-- | Selects whether X-Ray tracing is enabled.
updateStateMachine_tracingConfiguration :: Lens.Lens' UpdateStateMachine (Prelude.Maybe TracingConfiguration)
updateStateMachine_tracingConfiguration :: Lens' UpdateStateMachine (Maybe TracingConfiguration)
updateStateMachine_tracingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStateMachine' {Maybe TracingConfiguration
tracingConfiguration :: Maybe TracingConfiguration
$sel:tracingConfiguration:UpdateStateMachine' :: UpdateStateMachine -> Maybe TracingConfiguration
tracingConfiguration} -> Maybe TracingConfiguration
tracingConfiguration) (\s :: UpdateStateMachine
s@UpdateStateMachine' {} Maybe TracingConfiguration
a -> UpdateStateMachine
s {$sel:tracingConfiguration:UpdateStateMachine' :: Maybe TracingConfiguration
tracingConfiguration = Maybe TracingConfiguration
a} :: UpdateStateMachine)

-- | The Amazon Resource Name (ARN) of the state machine.
updateStateMachine_stateMachineArn :: Lens.Lens' UpdateStateMachine Prelude.Text
updateStateMachine_stateMachineArn :: Lens' UpdateStateMachine Text
updateStateMachine_stateMachineArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStateMachine' {Text
stateMachineArn :: Text
$sel:stateMachineArn:UpdateStateMachine' :: UpdateStateMachine -> Text
stateMachineArn} -> Text
stateMachineArn) (\s :: UpdateStateMachine
s@UpdateStateMachine' {} Text
a -> UpdateStateMachine
s {$sel:stateMachineArn:UpdateStateMachine' :: Text
stateMachineArn = Text
a} :: UpdateStateMachine)

instance Core.AWSRequest UpdateStateMachine where
  type
    AWSResponse UpdateStateMachine =
      UpdateStateMachineResponse
  request :: (Service -> Service)
-> UpdateStateMachine -> Request UpdateStateMachine
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 UpdateStateMachine
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateStateMachine)))
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 ->
          Int -> POSIX -> UpdateStateMachineResponse
UpdateStateMachineResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"updateDate")
      )

instance Prelude.Hashable UpdateStateMachine where
  hashWithSalt :: Int -> UpdateStateMachine -> Int
hashWithSalt Int
_salt UpdateStateMachine' {Maybe Text
Maybe (Sensitive Text)
Maybe LoggingConfiguration
Maybe TracingConfiguration
Text
stateMachineArn :: Text
tracingConfiguration :: Maybe TracingConfiguration
roleArn :: Maybe Text
loggingConfiguration :: Maybe LoggingConfiguration
definition :: Maybe (Sensitive Text)
$sel:stateMachineArn:UpdateStateMachine' :: UpdateStateMachine -> Text
$sel:tracingConfiguration:UpdateStateMachine' :: UpdateStateMachine -> Maybe TracingConfiguration
$sel:roleArn:UpdateStateMachine' :: UpdateStateMachine -> Maybe Text
$sel:loggingConfiguration:UpdateStateMachine' :: UpdateStateMachine -> Maybe LoggingConfiguration
$sel:definition:UpdateStateMachine' :: UpdateStateMachine -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
definition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoggingConfiguration
loggingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TracingConfiguration
tracingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stateMachineArn

instance Prelude.NFData UpdateStateMachine where
  rnf :: UpdateStateMachine -> ()
rnf UpdateStateMachine' {Maybe Text
Maybe (Sensitive Text)
Maybe LoggingConfiguration
Maybe TracingConfiguration
Text
stateMachineArn :: Text
tracingConfiguration :: Maybe TracingConfiguration
roleArn :: Maybe Text
loggingConfiguration :: Maybe LoggingConfiguration
definition :: Maybe (Sensitive Text)
$sel:stateMachineArn:UpdateStateMachine' :: UpdateStateMachine -> Text
$sel:tracingConfiguration:UpdateStateMachine' :: UpdateStateMachine -> Maybe TracingConfiguration
$sel:roleArn:UpdateStateMachine' :: UpdateStateMachine -> Maybe Text
$sel:loggingConfiguration:UpdateStateMachine' :: UpdateStateMachine -> Maybe LoggingConfiguration
$sel:definition:UpdateStateMachine' :: UpdateStateMachine -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
definition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoggingConfiguration
loggingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TracingConfiguration
tracingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stateMachineArn

instance Data.ToHeaders UpdateStateMachine where
  toHeaders :: UpdateStateMachine -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSStepFunctions.UpdateStateMachine" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateStateMachine where
  toJSON :: UpdateStateMachine -> Value
toJSON UpdateStateMachine' {Maybe Text
Maybe (Sensitive Text)
Maybe LoggingConfiguration
Maybe TracingConfiguration
Text
stateMachineArn :: Text
tracingConfiguration :: Maybe TracingConfiguration
roleArn :: Maybe Text
loggingConfiguration :: Maybe LoggingConfiguration
definition :: Maybe (Sensitive Text)
$sel:stateMachineArn:UpdateStateMachine' :: UpdateStateMachine -> Text
$sel:tracingConfiguration:UpdateStateMachine' :: UpdateStateMachine -> Maybe TracingConfiguration
$sel:roleArn:UpdateStateMachine' :: UpdateStateMachine -> Maybe Text
$sel:loggingConfiguration:UpdateStateMachine' :: UpdateStateMachine -> Maybe LoggingConfiguration
$sel:definition:UpdateStateMachine' :: UpdateStateMachine -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"definition" 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 (Sensitive Text)
definition,
            (Key
"loggingConfiguration" 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 LoggingConfiguration
loggingConfiguration,
            (Key
"roleArn" 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
roleArn,
            (Key
"tracingConfiguration" 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 TracingConfiguration
tracingConfiguration,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"stateMachineArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stateMachineArn)
          ]
      )

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

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

-- | /See:/ 'newUpdateStateMachineResponse' smart constructor.
data UpdateStateMachineResponse = UpdateStateMachineResponse'
  { -- | The response's http status code.
    UpdateStateMachineResponse -> Int
httpStatus :: Prelude.Int,
    -- | The date and time the state machine was updated.
    UpdateStateMachineResponse -> POSIX
updateDate :: Data.POSIX
  }
  deriving (UpdateStateMachineResponse -> UpdateStateMachineResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStateMachineResponse -> UpdateStateMachineResponse -> Bool
$c/= :: UpdateStateMachineResponse -> UpdateStateMachineResponse -> Bool
== :: UpdateStateMachineResponse -> UpdateStateMachineResponse -> Bool
$c== :: UpdateStateMachineResponse -> UpdateStateMachineResponse -> Bool
Prelude.Eq, ReadPrec [UpdateStateMachineResponse]
ReadPrec UpdateStateMachineResponse
Int -> ReadS UpdateStateMachineResponse
ReadS [UpdateStateMachineResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateStateMachineResponse]
$creadListPrec :: ReadPrec [UpdateStateMachineResponse]
readPrec :: ReadPrec UpdateStateMachineResponse
$creadPrec :: ReadPrec UpdateStateMachineResponse
readList :: ReadS [UpdateStateMachineResponse]
$creadList :: ReadS [UpdateStateMachineResponse]
readsPrec :: Int -> ReadS UpdateStateMachineResponse
$creadsPrec :: Int -> ReadS UpdateStateMachineResponse
Prelude.Read, Int -> UpdateStateMachineResponse -> ShowS
[UpdateStateMachineResponse] -> ShowS
UpdateStateMachineResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStateMachineResponse] -> ShowS
$cshowList :: [UpdateStateMachineResponse] -> ShowS
show :: UpdateStateMachineResponse -> String
$cshow :: UpdateStateMachineResponse -> String
showsPrec :: Int -> UpdateStateMachineResponse -> ShowS
$cshowsPrec :: Int -> UpdateStateMachineResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateStateMachineResponse x -> UpdateStateMachineResponse
forall x.
UpdateStateMachineResponse -> Rep UpdateStateMachineResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateStateMachineResponse x -> UpdateStateMachineResponse
$cfrom :: forall x.
UpdateStateMachineResponse -> Rep UpdateStateMachineResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateStateMachineResponse' 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:
--
-- 'httpStatus', 'updateStateMachineResponse_httpStatus' - The response's http status code.
--
-- 'updateDate', 'updateStateMachineResponse_updateDate' - The date and time the state machine was updated.
newUpdateStateMachineResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'updateDate'
  Prelude.UTCTime ->
  UpdateStateMachineResponse
newUpdateStateMachineResponse :: Int -> UTCTime -> UpdateStateMachineResponse
newUpdateStateMachineResponse
  Int
pHttpStatus_
  UTCTime
pUpdateDate_ =
    UpdateStateMachineResponse'
      { $sel:httpStatus:UpdateStateMachineResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:updateDate:UpdateStateMachineResponse' :: POSIX
updateDate = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdateDate_
      }

-- | The response's http status code.
updateStateMachineResponse_httpStatus :: Lens.Lens' UpdateStateMachineResponse Prelude.Int
updateStateMachineResponse_httpStatus :: Lens' UpdateStateMachineResponse Int
updateStateMachineResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStateMachineResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateStateMachineResponse' :: UpdateStateMachineResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateStateMachineResponse
s@UpdateStateMachineResponse' {} Int
a -> UpdateStateMachineResponse
s {$sel:httpStatus:UpdateStateMachineResponse' :: Int
httpStatus = Int
a} :: UpdateStateMachineResponse)

-- | The date and time the state machine was updated.
updateStateMachineResponse_updateDate :: Lens.Lens' UpdateStateMachineResponse Prelude.UTCTime
updateStateMachineResponse_updateDate :: Lens' UpdateStateMachineResponse UTCTime
updateStateMachineResponse_updateDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStateMachineResponse' {POSIX
updateDate :: POSIX
$sel:updateDate:UpdateStateMachineResponse' :: UpdateStateMachineResponse -> POSIX
updateDate} -> POSIX
updateDate) (\s :: UpdateStateMachineResponse
s@UpdateStateMachineResponse' {} POSIX
a -> UpdateStateMachineResponse
s {$sel:updateDate:UpdateStateMachineResponse' :: POSIX
updateDate = POSIX
a} :: UpdateStateMachineResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData UpdateStateMachineResponse where
  rnf :: UpdateStateMachineResponse -> ()
rnf UpdateStateMachineResponse' {Int
POSIX
updateDate :: POSIX
httpStatus :: Int
$sel:updateDate:UpdateStateMachineResponse' :: UpdateStateMachineResponse -> POSIX
$sel:httpStatus:UpdateStateMachineResponse' :: UpdateStateMachineResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
updateDate