{-# 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.MigrationHubReFactorSpaces.UpdateRoute
-- 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 Amazon Web Services Migration Hub Refactor Spaces route.
module Amazonka.MigrationHubReFactorSpaces.UpdateRoute
  ( -- * Creating a Request
    UpdateRoute (..),
    newUpdateRoute,

    -- * Request Lenses
    updateRoute_activationState,
    updateRoute_applicationIdentifier,
    updateRoute_environmentIdentifier,
    updateRoute_routeIdentifier,

    -- * Destructuring the Response
    UpdateRouteResponse (..),
    newUpdateRouteResponse,

    -- * Response Lenses
    updateRouteResponse_applicationId,
    updateRouteResponse_arn,
    updateRouteResponse_lastUpdatedTime,
    updateRouteResponse_routeId,
    updateRouteResponse_serviceId,
    updateRouteResponse_state,
    updateRouteResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateRoute' smart constructor.
data UpdateRoute = UpdateRoute'
  { -- | If set to @ACTIVE@, traffic is forwarded to this route’s service after
    -- the route is updated.
    UpdateRoute -> RouteActivationState
activationState :: RouteActivationState,
    -- | The ID of the application within which the route is being updated.
    UpdateRoute -> Text
applicationIdentifier :: Prelude.Text,
    -- | The ID of the environment in which the route is being updated.
    UpdateRoute -> Text
environmentIdentifier :: Prelude.Text,
    -- | The unique identifier of the route to update.
    UpdateRoute -> Text
routeIdentifier :: Prelude.Text
  }
  deriving (UpdateRoute -> UpdateRoute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRoute -> UpdateRoute -> Bool
$c/= :: UpdateRoute -> UpdateRoute -> Bool
== :: UpdateRoute -> UpdateRoute -> Bool
$c== :: UpdateRoute -> UpdateRoute -> Bool
Prelude.Eq, ReadPrec [UpdateRoute]
ReadPrec UpdateRoute
Int -> ReadS UpdateRoute
ReadS [UpdateRoute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRoute]
$creadListPrec :: ReadPrec [UpdateRoute]
readPrec :: ReadPrec UpdateRoute
$creadPrec :: ReadPrec UpdateRoute
readList :: ReadS [UpdateRoute]
$creadList :: ReadS [UpdateRoute]
readsPrec :: Int -> ReadS UpdateRoute
$creadsPrec :: Int -> ReadS UpdateRoute
Prelude.Read, Int -> UpdateRoute -> ShowS
[UpdateRoute] -> ShowS
UpdateRoute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRoute] -> ShowS
$cshowList :: [UpdateRoute] -> ShowS
show :: UpdateRoute -> String
$cshow :: UpdateRoute -> String
showsPrec :: Int -> UpdateRoute -> ShowS
$cshowsPrec :: Int -> UpdateRoute -> ShowS
Prelude.Show, forall x. Rep UpdateRoute x -> UpdateRoute
forall x. UpdateRoute -> Rep UpdateRoute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateRoute x -> UpdateRoute
$cfrom :: forall x. UpdateRoute -> Rep UpdateRoute x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRoute' 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:
--
-- 'activationState', 'updateRoute_activationState' - If set to @ACTIVE@, traffic is forwarded to this route’s service after
-- the route is updated.
--
-- 'applicationIdentifier', 'updateRoute_applicationIdentifier' - The ID of the application within which the route is being updated.
--
-- 'environmentIdentifier', 'updateRoute_environmentIdentifier' - The ID of the environment in which the route is being updated.
--
-- 'routeIdentifier', 'updateRoute_routeIdentifier' - The unique identifier of the route to update.
newUpdateRoute ::
  -- | 'activationState'
  RouteActivationState ->
  -- | 'applicationIdentifier'
  Prelude.Text ->
  -- | 'environmentIdentifier'
  Prelude.Text ->
  -- | 'routeIdentifier'
  Prelude.Text ->
  UpdateRoute
newUpdateRoute :: RouteActivationState -> Text -> Text -> Text -> UpdateRoute
newUpdateRoute
  RouteActivationState
pActivationState_
  Text
pApplicationIdentifier_
  Text
pEnvironmentIdentifier_
  Text
pRouteIdentifier_ =
    UpdateRoute'
      { $sel:activationState:UpdateRoute' :: RouteActivationState
activationState = RouteActivationState
pActivationState_,
        $sel:applicationIdentifier:UpdateRoute' :: Text
applicationIdentifier = Text
pApplicationIdentifier_,
        $sel:environmentIdentifier:UpdateRoute' :: Text
environmentIdentifier = Text
pEnvironmentIdentifier_,
        $sel:routeIdentifier:UpdateRoute' :: Text
routeIdentifier = Text
pRouteIdentifier_
      }

-- | If set to @ACTIVE@, traffic is forwarded to this route’s service after
-- the route is updated.
updateRoute_activationState :: Lens.Lens' UpdateRoute RouteActivationState
updateRoute_activationState :: Lens' UpdateRoute RouteActivationState
updateRoute_activationState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoute' {RouteActivationState
activationState :: RouteActivationState
$sel:activationState:UpdateRoute' :: UpdateRoute -> RouteActivationState
activationState} -> RouteActivationState
activationState) (\s :: UpdateRoute
s@UpdateRoute' {} RouteActivationState
a -> UpdateRoute
s {$sel:activationState:UpdateRoute' :: RouteActivationState
activationState = RouteActivationState
a} :: UpdateRoute)

-- | The ID of the application within which the route is being updated.
updateRoute_applicationIdentifier :: Lens.Lens' UpdateRoute Prelude.Text
updateRoute_applicationIdentifier :: Lens' UpdateRoute Text
updateRoute_applicationIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoute' {Text
applicationIdentifier :: Text
$sel:applicationIdentifier:UpdateRoute' :: UpdateRoute -> Text
applicationIdentifier} -> Text
applicationIdentifier) (\s :: UpdateRoute
s@UpdateRoute' {} Text
a -> UpdateRoute
s {$sel:applicationIdentifier:UpdateRoute' :: Text
applicationIdentifier = Text
a} :: UpdateRoute)

-- | The ID of the environment in which the route is being updated.
updateRoute_environmentIdentifier :: Lens.Lens' UpdateRoute Prelude.Text
updateRoute_environmentIdentifier :: Lens' UpdateRoute Text
updateRoute_environmentIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoute' {Text
environmentIdentifier :: Text
$sel:environmentIdentifier:UpdateRoute' :: UpdateRoute -> Text
environmentIdentifier} -> Text
environmentIdentifier) (\s :: UpdateRoute
s@UpdateRoute' {} Text
a -> UpdateRoute
s {$sel:environmentIdentifier:UpdateRoute' :: Text
environmentIdentifier = Text
a} :: UpdateRoute)

-- | The unique identifier of the route to update.
updateRoute_routeIdentifier :: Lens.Lens' UpdateRoute Prelude.Text
updateRoute_routeIdentifier :: Lens' UpdateRoute Text
updateRoute_routeIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoute' {Text
routeIdentifier :: Text
$sel:routeIdentifier:UpdateRoute' :: UpdateRoute -> Text
routeIdentifier} -> Text
routeIdentifier) (\s :: UpdateRoute
s@UpdateRoute' {} Text
a -> UpdateRoute
s {$sel:routeIdentifier:UpdateRoute' :: Text
routeIdentifier = Text
a} :: UpdateRoute)

instance Core.AWSRequest UpdateRoute where
  type AWSResponse UpdateRoute = UpdateRouteResponse
  request :: (Service -> Service) -> UpdateRoute -> Request UpdateRoute
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateRoute
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateRoute)))
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 ->
          Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe RouteState
-> Int
-> UpdateRouteResponse
UpdateRouteResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ApplicationId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LastUpdatedTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RouteId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ServiceId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"State")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable UpdateRoute where
  hashWithSalt :: Int -> UpdateRoute -> Int
hashWithSalt Int
_salt UpdateRoute' {Text
RouteActivationState
routeIdentifier :: Text
environmentIdentifier :: Text
applicationIdentifier :: Text
activationState :: RouteActivationState
$sel:routeIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:environmentIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:applicationIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:activationState:UpdateRoute' :: UpdateRoute -> RouteActivationState
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RouteActivationState
activationState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
environmentIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
routeIdentifier

instance Prelude.NFData UpdateRoute where
  rnf :: UpdateRoute -> ()
rnf UpdateRoute' {Text
RouteActivationState
routeIdentifier :: Text
environmentIdentifier :: Text
applicationIdentifier :: Text
activationState :: RouteActivationState
$sel:routeIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:environmentIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:applicationIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:activationState:UpdateRoute' :: UpdateRoute -> RouteActivationState
..} =
    forall a. NFData a => a -> ()
Prelude.rnf RouteActivationState
activationState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
environmentIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
routeIdentifier

instance Data.ToHeaders UpdateRoute where
  toHeaders :: UpdateRoute -> 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 UpdateRoute where
  toJSON :: UpdateRoute -> Value
toJSON UpdateRoute' {Text
RouteActivationState
routeIdentifier :: Text
environmentIdentifier :: Text
applicationIdentifier :: Text
activationState :: RouteActivationState
$sel:routeIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:environmentIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:applicationIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:activationState:UpdateRoute' :: UpdateRoute -> RouteActivationState
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ActivationState" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RouteActivationState
activationState)
          ]
      )

instance Data.ToPath UpdateRoute where
  toPath :: UpdateRoute -> ByteString
toPath UpdateRoute' {Text
RouteActivationState
routeIdentifier :: Text
environmentIdentifier :: Text
applicationIdentifier :: Text
activationState :: RouteActivationState
$sel:routeIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:environmentIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:applicationIdentifier:UpdateRoute' :: UpdateRoute -> Text
$sel:activationState:UpdateRoute' :: UpdateRoute -> RouteActivationState
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/environments/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
environmentIdentifier,
        ByteString
"/applications/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationIdentifier,
        ByteString
"/routes/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
routeIdentifier
      ]

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

-- | /See:/ 'newUpdateRouteResponse' smart constructor.
data UpdateRouteResponse = UpdateRouteResponse'
  { -- | The ID of the application in which the route is being updated.
    UpdateRouteResponse -> Maybe Text
applicationId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the route. The format for this ARN is
    -- @arn:aws:refactor-spaces:@/@region@/@:@/@account-id@/@:@/@resource-type\/resource-id@/@ @.
    -- For more information about ARNs, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
    -- in the /Amazon Web Services General Reference/.
    UpdateRouteResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | A timestamp that indicates when the route was last updated.
    UpdateRouteResponse -> Maybe POSIX
lastUpdatedTime :: Prelude.Maybe Data.POSIX,
    -- | The unique identifier of the route.
    UpdateRouteResponse -> Maybe Text
routeId :: Prelude.Maybe Prelude.Text,
    -- | The ID of service in which the route was created. Traffic that matches
    -- this route is forwarded to this service.
    UpdateRouteResponse -> Maybe Text
serviceId :: Prelude.Maybe Prelude.Text,
    -- | The current state of the route.
    UpdateRouteResponse -> Maybe RouteState
state :: Prelude.Maybe RouteState,
    -- | The response's http status code.
    UpdateRouteResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateRouteResponse -> UpdateRouteResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRouteResponse -> UpdateRouteResponse -> Bool
$c/= :: UpdateRouteResponse -> UpdateRouteResponse -> Bool
== :: UpdateRouteResponse -> UpdateRouteResponse -> Bool
$c== :: UpdateRouteResponse -> UpdateRouteResponse -> Bool
Prelude.Eq, ReadPrec [UpdateRouteResponse]
ReadPrec UpdateRouteResponse
Int -> ReadS UpdateRouteResponse
ReadS [UpdateRouteResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRouteResponse]
$creadListPrec :: ReadPrec [UpdateRouteResponse]
readPrec :: ReadPrec UpdateRouteResponse
$creadPrec :: ReadPrec UpdateRouteResponse
readList :: ReadS [UpdateRouteResponse]
$creadList :: ReadS [UpdateRouteResponse]
readsPrec :: Int -> ReadS UpdateRouteResponse
$creadsPrec :: Int -> ReadS UpdateRouteResponse
Prelude.Read, Int -> UpdateRouteResponse -> ShowS
[UpdateRouteResponse] -> ShowS
UpdateRouteResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRouteResponse] -> ShowS
$cshowList :: [UpdateRouteResponse] -> ShowS
show :: UpdateRouteResponse -> String
$cshow :: UpdateRouteResponse -> String
showsPrec :: Int -> UpdateRouteResponse -> ShowS
$cshowsPrec :: Int -> UpdateRouteResponse -> ShowS
Prelude.Show, forall x. Rep UpdateRouteResponse x -> UpdateRouteResponse
forall x. UpdateRouteResponse -> Rep UpdateRouteResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateRouteResponse x -> UpdateRouteResponse
$cfrom :: forall x. UpdateRouteResponse -> Rep UpdateRouteResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRouteResponse' 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:
--
-- 'applicationId', 'updateRouteResponse_applicationId' - The ID of the application in which the route is being updated.
--
-- 'arn', 'updateRouteResponse_arn' - The Amazon Resource Name (ARN) of the route. The format for this ARN is
-- @arn:aws:refactor-spaces:@/@region@/@:@/@account-id@/@:@/@resource-type\/resource-id@/@ @.
-- For more information about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /Amazon Web Services General Reference/.
--
-- 'lastUpdatedTime', 'updateRouteResponse_lastUpdatedTime' - A timestamp that indicates when the route was last updated.
--
-- 'routeId', 'updateRouteResponse_routeId' - The unique identifier of the route.
--
-- 'serviceId', 'updateRouteResponse_serviceId' - The ID of service in which the route was created. Traffic that matches
-- this route is forwarded to this service.
--
-- 'state', 'updateRouteResponse_state' - The current state of the route.
--
-- 'httpStatus', 'updateRouteResponse_httpStatus' - The response's http status code.
newUpdateRouteResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateRouteResponse
newUpdateRouteResponse :: Int -> UpdateRouteResponse
newUpdateRouteResponse Int
pHttpStatus_ =
  UpdateRouteResponse'
    { $sel:applicationId:UpdateRouteResponse' :: Maybe Text
applicationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:arn:UpdateRouteResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedTime:UpdateRouteResponse' :: Maybe POSIX
lastUpdatedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:routeId:UpdateRouteResponse' :: Maybe Text
routeId = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceId:UpdateRouteResponse' :: Maybe Text
serviceId = forall a. Maybe a
Prelude.Nothing,
      $sel:state:UpdateRouteResponse' :: Maybe RouteState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateRouteResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the application in which the route is being updated.
updateRouteResponse_applicationId :: Lens.Lens' UpdateRouteResponse (Prelude.Maybe Prelude.Text)
updateRouteResponse_applicationId :: Lens' UpdateRouteResponse (Maybe Text)
updateRouteResponse_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRouteResponse' {Maybe Text
applicationId :: Maybe Text
$sel:applicationId:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe Text
applicationId} -> Maybe Text
applicationId) (\s :: UpdateRouteResponse
s@UpdateRouteResponse' {} Maybe Text
a -> UpdateRouteResponse
s {$sel:applicationId:UpdateRouteResponse' :: Maybe Text
applicationId = Maybe Text
a} :: UpdateRouteResponse)

-- | The Amazon Resource Name (ARN) of the route. The format for this ARN is
-- @arn:aws:refactor-spaces:@/@region@/@:@/@account-id@/@:@/@resource-type\/resource-id@/@ @.
-- For more information about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /Amazon Web Services General Reference/.
updateRouteResponse_arn :: Lens.Lens' UpdateRouteResponse (Prelude.Maybe Prelude.Text)
updateRouteResponse_arn :: Lens' UpdateRouteResponse (Maybe Text)
updateRouteResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRouteResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: UpdateRouteResponse
s@UpdateRouteResponse' {} Maybe Text
a -> UpdateRouteResponse
s {$sel:arn:UpdateRouteResponse' :: Maybe Text
arn = Maybe Text
a} :: UpdateRouteResponse)

-- | A timestamp that indicates when the route was last updated.
updateRouteResponse_lastUpdatedTime :: Lens.Lens' UpdateRouteResponse (Prelude.Maybe Prelude.UTCTime)
updateRouteResponse_lastUpdatedTime :: Lens' UpdateRouteResponse (Maybe UTCTime)
updateRouteResponse_lastUpdatedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRouteResponse' {Maybe POSIX
lastUpdatedTime :: Maybe POSIX
$sel:lastUpdatedTime:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe POSIX
lastUpdatedTime} -> Maybe POSIX
lastUpdatedTime) (\s :: UpdateRouteResponse
s@UpdateRouteResponse' {} Maybe POSIX
a -> UpdateRouteResponse
s {$sel:lastUpdatedTime:UpdateRouteResponse' :: Maybe POSIX
lastUpdatedTime = Maybe POSIX
a} :: UpdateRouteResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The unique identifier of the route.
updateRouteResponse_routeId :: Lens.Lens' UpdateRouteResponse (Prelude.Maybe Prelude.Text)
updateRouteResponse_routeId :: Lens' UpdateRouteResponse (Maybe Text)
updateRouteResponse_routeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRouteResponse' {Maybe Text
routeId :: Maybe Text
$sel:routeId:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe Text
routeId} -> Maybe Text
routeId) (\s :: UpdateRouteResponse
s@UpdateRouteResponse' {} Maybe Text
a -> UpdateRouteResponse
s {$sel:routeId:UpdateRouteResponse' :: Maybe Text
routeId = Maybe Text
a} :: UpdateRouteResponse)

-- | The ID of service in which the route was created. Traffic that matches
-- this route is forwarded to this service.
updateRouteResponse_serviceId :: Lens.Lens' UpdateRouteResponse (Prelude.Maybe Prelude.Text)
updateRouteResponse_serviceId :: Lens' UpdateRouteResponse (Maybe Text)
updateRouteResponse_serviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRouteResponse' {Maybe Text
serviceId :: Maybe Text
$sel:serviceId:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe Text
serviceId} -> Maybe Text
serviceId) (\s :: UpdateRouteResponse
s@UpdateRouteResponse' {} Maybe Text
a -> UpdateRouteResponse
s {$sel:serviceId:UpdateRouteResponse' :: Maybe Text
serviceId = Maybe Text
a} :: UpdateRouteResponse)

-- | The current state of the route.
updateRouteResponse_state :: Lens.Lens' UpdateRouteResponse (Prelude.Maybe RouteState)
updateRouteResponse_state :: Lens' UpdateRouteResponse (Maybe RouteState)
updateRouteResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRouteResponse' {Maybe RouteState
state :: Maybe RouteState
$sel:state:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe RouteState
state} -> Maybe RouteState
state) (\s :: UpdateRouteResponse
s@UpdateRouteResponse' {} Maybe RouteState
a -> UpdateRouteResponse
s {$sel:state:UpdateRouteResponse' :: Maybe RouteState
state = Maybe RouteState
a} :: UpdateRouteResponse)

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

instance Prelude.NFData UpdateRouteResponse where
  rnf :: UpdateRouteResponse -> ()
rnf UpdateRouteResponse' {Int
Maybe Text
Maybe POSIX
Maybe RouteState
httpStatus :: Int
state :: Maybe RouteState
serviceId :: Maybe Text
routeId :: Maybe Text
lastUpdatedTime :: Maybe POSIX
arn :: Maybe Text
applicationId :: Maybe Text
$sel:httpStatus:UpdateRouteResponse' :: UpdateRouteResponse -> Int
$sel:state:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe RouteState
$sel:serviceId:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe Text
$sel:routeId:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe Text
$sel:lastUpdatedTime:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe POSIX
$sel:arn:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe Text
$sel:applicationId:UpdateRouteResponse' :: UpdateRouteResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
routeId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RouteState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus