{-# 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.EC2.CreateTransitGatewayRoute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a static route for the specified transit gateway route table.
module Amazonka.EC2.CreateTransitGatewayRoute
  ( -- * Creating a Request
    CreateTransitGatewayRoute (..),
    newCreateTransitGatewayRoute,

    -- * Request Lenses
    createTransitGatewayRoute_blackhole,
    createTransitGatewayRoute_dryRun,
    createTransitGatewayRoute_transitGatewayAttachmentId,
    createTransitGatewayRoute_destinationCidrBlock,
    createTransitGatewayRoute_transitGatewayRouteTableId,

    -- * Destructuring the Response
    CreateTransitGatewayRouteResponse (..),
    newCreateTransitGatewayRouteResponse,

    -- * Response Lenses
    createTransitGatewayRouteResponse_route,
    createTransitGatewayRouteResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateTransitGatewayRoute' smart constructor.
data CreateTransitGatewayRoute = CreateTransitGatewayRoute'
  { -- | Indicates whether to drop traffic that matches this route.
    CreateTransitGatewayRoute -> Maybe Bool
blackhole :: Prelude.Maybe Prelude.Bool,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    CreateTransitGatewayRoute -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the attachment.
    CreateTransitGatewayRoute -> Maybe Text
transitGatewayAttachmentId :: Prelude.Maybe Prelude.Text,
    -- | The CIDR range used for destination matches. Routing decisions are based
    -- on the most specific match.
    CreateTransitGatewayRoute -> Text
destinationCidrBlock :: Prelude.Text,
    -- | The ID of the transit gateway route table.
    CreateTransitGatewayRoute -> Text
transitGatewayRouteTableId :: Prelude.Text
  }
  deriving (CreateTransitGatewayRoute -> CreateTransitGatewayRoute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTransitGatewayRoute -> CreateTransitGatewayRoute -> Bool
$c/= :: CreateTransitGatewayRoute -> CreateTransitGatewayRoute -> Bool
== :: CreateTransitGatewayRoute -> CreateTransitGatewayRoute -> Bool
$c== :: CreateTransitGatewayRoute -> CreateTransitGatewayRoute -> Bool
Prelude.Eq, ReadPrec [CreateTransitGatewayRoute]
ReadPrec CreateTransitGatewayRoute
Int -> ReadS CreateTransitGatewayRoute
ReadS [CreateTransitGatewayRoute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTransitGatewayRoute]
$creadListPrec :: ReadPrec [CreateTransitGatewayRoute]
readPrec :: ReadPrec CreateTransitGatewayRoute
$creadPrec :: ReadPrec CreateTransitGatewayRoute
readList :: ReadS [CreateTransitGatewayRoute]
$creadList :: ReadS [CreateTransitGatewayRoute]
readsPrec :: Int -> ReadS CreateTransitGatewayRoute
$creadsPrec :: Int -> ReadS CreateTransitGatewayRoute
Prelude.Read, Int -> CreateTransitGatewayRoute -> ShowS
[CreateTransitGatewayRoute] -> ShowS
CreateTransitGatewayRoute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTransitGatewayRoute] -> ShowS
$cshowList :: [CreateTransitGatewayRoute] -> ShowS
show :: CreateTransitGatewayRoute -> String
$cshow :: CreateTransitGatewayRoute -> String
showsPrec :: Int -> CreateTransitGatewayRoute -> ShowS
$cshowsPrec :: Int -> CreateTransitGatewayRoute -> ShowS
Prelude.Show, forall x.
Rep CreateTransitGatewayRoute x -> CreateTransitGatewayRoute
forall x.
CreateTransitGatewayRoute -> Rep CreateTransitGatewayRoute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateTransitGatewayRoute x -> CreateTransitGatewayRoute
$cfrom :: forall x.
CreateTransitGatewayRoute -> Rep CreateTransitGatewayRoute x
Prelude.Generic)

-- |
-- Create a value of 'CreateTransitGatewayRoute' 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:
--
-- 'blackhole', 'createTransitGatewayRoute_blackhole' - Indicates whether to drop traffic that matches this route.
--
-- 'dryRun', 'createTransitGatewayRoute_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'transitGatewayAttachmentId', 'createTransitGatewayRoute_transitGatewayAttachmentId' - The ID of the attachment.
--
-- 'destinationCidrBlock', 'createTransitGatewayRoute_destinationCidrBlock' - The CIDR range used for destination matches. Routing decisions are based
-- on the most specific match.
--
-- 'transitGatewayRouteTableId', 'createTransitGatewayRoute_transitGatewayRouteTableId' - The ID of the transit gateway route table.
newCreateTransitGatewayRoute ::
  -- | 'destinationCidrBlock'
  Prelude.Text ->
  -- | 'transitGatewayRouteTableId'
  Prelude.Text ->
  CreateTransitGatewayRoute
newCreateTransitGatewayRoute :: Text -> Text -> CreateTransitGatewayRoute
newCreateTransitGatewayRoute
  Text
pDestinationCidrBlock_
  Text
pTransitGatewayRouteTableId_ =
    CreateTransitGatewayRoute'
      { $sel:blackhole:CreateTransitGatewayRoute' :: Maybe Bool
blackhole =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dryRun:CreateTransitGatewayRoute' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:transitGatewayAttachmentId:CreateTransitGatewayRoute' :: Maybe Text
transitGatewayAttachmentId = forall a. Maybe a
Prelude.Nothing,
        $sel:destinationCidrBlock:CreateTransitGatewayRoute' :: Text
destinationCidrBlock = Text
pDestinationCidrBlock_,
        $sel:transitGatewayRouteTableId:CreateTransitGatewayRoute' :: Text
transitGatewayRouteTableId =
          Text
pTransitGatewayRouteTableId_
      }

-- | Indicates whether to drop traffic that matches this route.
createTransitGatewayRoute_blackhole :: Lens.Lens' CreateTransitGatewayRoute (Prelude.Maybe Prelude.Bool)
createTransitGatewayRoute_blackhole :: Lens' CreateTransitGatewayRoute (Maybe Bool)
createTransitGatewayRoute_blackhole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRoute' {Maybe Bool
blackhole :: Maybe Bool
$sel:blackhole:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Bool
blackhole} -> Maybe Bool
blackhole) (\s :: CreateTransitGatewayRoute
s@CreateTransitGatewayRoute' {} Maybe Bool
a -> CreateTransitGatewayRoute
s {$sel:blackhole:CreateTransitGatewayRoute' :: Maybe Bool
blackhole = Maybe Bool
a} :: CreateTransitGatewayRoute)

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
createTransitGatewayRoute_dryRun :: Lens.Lens' CreateTransitGatewayRoute (Prelude.Maybe Prelude.Bool)
createTransitGatewayRoute_dryRun :: Lens' CreateTransitGatewayRoute (Maybe Bool)
createTransitGatewayRoute_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRoute' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateTransitGatewayRoute
s@CreateTransitGatewayRoute' {} Maybe Bool
a -> CreateTransitGatewayRoute
s {$sel:dryRun:CreateTransitGatewayRoute' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateTransitGatewayRoute)

-- | The ID of the attachment.
createTransitGatewayRoute_transitGatewayAttachmentId :: Lens.Lens' CreateTransitGatewayRoute (Prelude.Maybe Prelude.Text)
createTransitGatewayRoute_transitGatewayAttachmentId :: Lens' CreateTransitGatewayRoute (Maybe Text)
createTransitGatewayRoute_transitGatewayAttachmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRoute' {Maybe Text
transitGatewayAttachmentId :: Maybe Text
$sel:transitGatewayAttachmentId:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Text
transitGatewayAttachmentId} -> Maybe Text
transitGatewayAttachmentId) (\s :: CreateTransitGatewayRoute
s@CreateTransitGatewayRoute' {} Maybe Text
a -> CreateTransitGatewayRoute
s {$sel:transitGatewayAttachmentId:CreateTransitGatewayRoute' :: Maybe Text
transitGatewayAttachmentId = Maybe Text
a} :: CreateTransitGatewayRoute)

-- | The CIDR range used for destination matches. Routing decisions are based
-- on the most specific match.
createTransitGatewayRoute_destinationCidrBlock :: Lens.Lens' CreateTransitGatewayRoute Prelude.Text
createTransitGatewayRoute_destinationCidrBlock :: Lens' CreateTransitGatewayRoute Text
createTransitGatewayRoute_destinationCidrBlock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRoute' {Text
destinationCidrBlock :: Text
$sel:destinationCidrBlock:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Text
destinationCidrBlock} -> Text
destinationCidrBlock) (\s :: CreateTransitGatewayRoute
s@CreateTransitGatewayRoute' {} Text
a -> CreateTransitGatewayRoute
s {$sel:destinationCidrBlock:CreateTransitGatewayRoute' :: Text
destinationCidrBlock = Text
a} :: CreateTransitGatewayRoute)

-- | The ID of the transit gateway route table.
createTransitGatewayRoute_transitGatewayRouteTableId :: Lens.Lens' CreateTransitGatewayRoute Prelude.Text
createTransitGatewayRoute_transitGatewayRouteTableId :: Lens' CreateTransitGatewayRoute Text
createTransitGatewayRoute_transitGatewayRouteTableId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRoute' {Text
transitGatewayRouteTableId :: Text
$sel:transitGatewayRouteTableId:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Text
transitGatewayRouteTableId} -> Text
transitGatewayRouteTableId) (\s :: CreateTransitGatewayRoute
s@CreateTransitGatewayRoute' {} Text
a -> CreateTransitGatewayRoute
s {$sel:transitGatewayRouteTableId:CreateTransitGatewayRoute' :: Text
transitGatewayRouteTableId = Text
a} :: CreateTransitGatewayRoute)

instance Core.AWSRequest CreateTransitGatewayRoute where
  type
    AWSResponse CreateTransitGatewayRoute =
      CreateTransitGatewayRouteResponse
  request :: (Service -> Service)
-> CreateTransitGatewayRoute -> Request CreateTransitGatewayRoute
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateTransitGatewayRoute
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateTransitGatewayRoute)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe TransitGatewayRoute
-> Int -> CreateTransitGatewayRouteResponse
CreateTransitGatewayRouteResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"route")
            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 CreateTransitGatewayRoute where
  hashWithSalt :: Int -> CreateTransitGatewayRoute -> Int
hashWithSalt Int
_salt CreateTransitGatewayRoute' {Maybe Bool
Maybe Text
Text
transitGatewayRouteTableId :: Text
destinationCidrBlock :: Text
transitGatewayAttachmentId :: Maybe Text
dryRun :: Maybe Bool
blackhole :: Maybe Bool
$sel:transitGatewayRouteTableId:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Text
$sel:destinationCidrBlock:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Text
$sel:transitGatewayAttachmentId:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Text
$sel:dryRun:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Bool
$sel:blackhole:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
blackhole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
transitGatewayAttachmentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationCidrBlock
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transitGatewayRouteTableId

instance Prelude.NFData CreateTransitGatewayRoute where
  rnf :: CreateTransitGatewayRoute -> ()
rnf CreateTransitGatewayRoute' {Maybe Bool
Maybe Text
Text
transitGatewayRouteTableId :: Text
destinationCidrBlock :: Text
transitGatewayAttachmentId :: Maybe Text
dryRun :: Maybe Bool
blackhole :: Maybe Bool
$sel:transitGatewayRouteTableId:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Text
$sel:destinationCidrBlock:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Text
$sel:transitGatewayAttachmentId:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Text
$sel:dryRun:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Bool
$sel:blackhole:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
blackhole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
transitGatewayAttachmentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationCidrBlock
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
transitGatewayRouteTableId

instance Data.ToHeaders CreateTransitGatewayRoute where
  toHeaders :: CreateTransitGatewayRoute -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery CreateTransitGatewayRoute where
  toQuery :: CreateTransitGatewayRoute -> QueryString
toQuery CreateTransitGatewayRoute' {Maybe Bool
Maybe Text
Text
transitGatewayRouteTableId :: Text
destinationCidrBlock :: Text
transitGatewayAttachmentId :: Maybe Text
dryRun :: Maybe Bool
blackhole :: Maybe Bool
$sel:transitGatewayRouteTableId:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Text
$sel:destinationCidrBlock:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Text
$sel:transitGatewayAttachmentId:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Text
$sel:dryRun:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Bool
$sel:blackhole:CreateTransitGatewayRoute' :: CreateTransitGatewayRoute -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateTransitGatewayRoute" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Blackhole" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
blackhole,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"TransitGatewayAttachmentId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
transitGatewayAttachmentId,
        ByteString
"DestinationCidrBlock" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
destinationCidrBlock,
        ByteString
"TransitGatewayRouteTableId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
transitGatewayRouteTableId
      ]

-- | /See:/ 'newCreateTransitGatewayRouteResponse' smart constructor.
data CreateTransitGatewayRouteResponse = CreateTransitGatewayRouteResponse'
  { -- | Information about the route.
    CreateTransitGatewayRouteResponse -> Maybe TransitGatewayRoute
route :: Prelude.Maybe TransitGatewayRoute,
    -- | The response's http status code.
    CreateTransitGatewayRouteResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateTransitGatewayRouteResponse
-> CreateTransitGatewayRouteResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTransitGatewayRouteResponse
-> CreateTransitGatewayRouteResponse -> Bool
$c/= :: CreateTransitGatewayRouteResponse
-> CreateTransitGatewayRouteResponse -> Bool
== :: CreateTransitGatewayRouteResponse
-> CreateTransitGatewayRouteResponse -> Bool
$c== :: CreateTransitGatewayRouteResponse
-> CreateTransitGatewayRouteResponse -> Bool
Prelude.Eq, ReadPrec [CreateTransitGatewayRouteResponse]
ReadPrec CreateTransitGatewayRouteResponse
Int -> ReadS CreateTransitGatewayRouteResponse
ReadS [CreateTransitGatewayRouteResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTransitGatewayRouteResponse]
$creadListPrec :: ReadPrec [CreateTransitGatewayRouteResponse]
readPrec :: ReadPrec CreateTransitGatewayRouteResponse
$creadPrec :: ReadPrec CreateTransitGatewayRouteResponse
readList :: ReadS [CreateTransitGatewayRouteResponse]
$creadList :: ReadS [CreateTransitGatewayRouteResponse]
readsPrec :: Int -> ReadS CreateTransitGatewayRouteResponse
$creadsPrec :: Int -> ReadS CreateTransitGatewayRouteResponse
Prelude.Read, Int -> CreateTransitGatewayRouteResponse -> ShowS
[CreateTransitGatewayRouteResponse] -> ShowS
CreateTransitGatewayRouteResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTransitGatewayRouteResponse] -> ShowS
$cshowList :: [CreateTransitGatewayRouteResponse] -> ShowS
show :: CreateTransitGatewayRouteResponse -> String
$cshow :: CreateTransitGatewayRouteResponse -> String
showsPrec :: Int -> CreateTransitGatewayRouteResponse -> ShowS
$cshowsPrec :: Int -> CreateTransitGatewayRouteResponse -> ShowS
Prelude.Show, forall x.
Rep CreateTransitGatewayRouteResponse x
-> CreateTransitGatewayRouteResponse
forall x.
CreateTransitGatewayRouteResponse
-> Rep CreateTransitGatewayRouteResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateTransitGatewayRouteResponse x
-> CreateTransitGatewayRouteResponse
$cfrom :: forall x.
CreateTransitGatewayRouteResponse
-> Rep CreateTransitGatewayRouteResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateTransitGatewayRouteResponse' 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:
--
-- 'route', 'createTransitGatewayRouteResponse_route' - Information about the route.
--
-- 'httpStatus', 'createTransitGatewayRouteResponse_httpStatus' - The response's http status code.
newCreateTransitGatewayRouteResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateTransitGatewayRouteResponse
newCreateTransitGatewayRouteResponse :: Int -> CreateTransitGatewayRouteResponse
newCreateTransitGatewayRouteResponse Int
pHttpStatus_ =
  CreateTransitGatewayRouteResponse'
    { $sel:route:CreateTransitGatewayRouteResponse' :: Maybe TransitGatewayRoute
route =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateTransitGatewayRouteResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the route.
createTransitGatewayRouteResponse_route :: Lens.Lens' CreateTransitGatewayRouteResponse (Prelude.Maybe TransitGatewayRoute)
createTransitGatewayRouteResponse_route :: Lens' CreateTransitGatewayRouteResponse (Maybe TransitGatewayRoute)
createTransitGatewayRouteResponse_route = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRouteResponse' {Maybe TransitGatewayRoute
route :: Maybe TransitGatewayRoute
$sel:route:CreateTransitGatewayRouteResponse' :: CreateTransitGatewayRouteResponse -> Maybe TransitGatewayRoute
route} -> Maybe TransitGatewayRoute
route) (\s :: CreateTransitGatewayRouteResponse
s@CreateTransitGatewayRouteResponse' {} Maybe TransitGatewayRoute
a -> CreateTransitGatewayRouteResponse
s {$sel:route:CreateTransitGatewayRouteResponse' :: Maybe TransitGatewayRoute
route = Maybe TransitGatewayRoute
a} :: CreateTransitGatewayRouteResponse)

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

instance
  Prelude.NFData
    CreateTransitGatewayRouteResponse
  where
  rnf :: CreateTransitGatewayRouteResponse -> ()
rnf CreateTransitGatewayRouteResponse' {Int
Maybe TransitGatewayRoute
httpStatus :: Int
route :: Maybe TransitGatewayRoute
$sel:httpStatus:CreateTransitGatewayRouteResponse' :: CreateTransitGatewayRouteResponse -> Int
$sel:route:CreateTransitGatewayRouteResponse' :: CreateTransitGatewayRouteResponse -> Maybe TransitGatewayRoute
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe TransitGatewayRoute
route
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus