{-# 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.AppMesh.CreateGatewayRoute
-- 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 gateway route.
--
-- A gateway route is attached to a virtual gateway and routes traffic to
-- an existing virtual service. If a route matches a request, it can
-- distribute traffic to a target virtual service.
--
-- For more information about gateway routes, see
-- <https://docs.aws.amazon.com/app-mesh/latest/userguide/gateway-routes.html Gateway routes>.
module Amazonka.AppMesh.CreateGatewayRoute
  ( -- * Creating a Request
    CreateGatewayRoute (..),
    newCreateGatewayRoute,

    -- * Request Lenses
    createGatewayRoute_clientToken,
    createGatewayRoute_meshOwner,
    createGatewayRoute_tags,
    createGatewayRoute_gatewayRouteName,
    createGatewayRoute_meshName,
    createGatewayRoute_spec,
    createGatewayRoute_virtualGatewayName,

    -- * Destructuring the Response
    CreateGatewayRouteResponse (..),
    newCreateGatewayRouteResponse,

    -- * Response Lenses
    createGatewayRouteResponse_httpStatus,
    createGatewayRouteResponse_gatewayRoute,
  )
where

import Amazonka.AppMesh.Types
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

-- | /See:/ 'newCreateGatewayRoute' smart constructor.
data CreateGatewayRoute = CreateGatewayRoute'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. Up to 36 letters, numbers, hyphens, and
    -- underscores are allowed.
    CreateGatewayRoute -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services IAM account ID of the service mesh owner. If the
    -- account ID is not your own, then the account that you specify must share
    -- the mesh with your account before you can create the resource in the
    -- service mesh. For more information about mesh sharing, see
    -- <https://docs.aws.amazon.com/app-mesh/latest/userguide/sharing.html Working with shared meshes>.
    CreateGatewayRoute -> Maybe Text
meshOwner :: Prelude.Maybe Prelude.Text,
    -- | Optional metadata that you can apply to the gateway route to assist with
    -- categorization and organization. Each tag consists of a key and an
    -- optional value, both of which you define. Tag keys can have a maximum
    -- character length of 128 characters, and tag values can have a maximum
    -- length of 256 characters.
    CreateGatewayRoute -> Maybe [TagRef]
tags :: Prelude.Maybe [TagRef],
    -- | The name to use for the gateway route.
    CreateGatewayRoute -> Text
gatewayRouteName :: Prelude.Text,
    -- | The name of the service mesh to create the gateway route in.
    CreateGatewayRoute -> Text
meshName :: Prelude.Text,
    -- | The gateway route specification to apply.
    CreateGatewayRoute -> GatewayRouteSpec
spec :: GatewayRouteSpec,
    -- | The name of the virtual gateway to associate the gateway route with. If
    -- the virtual gateway is in a shared mesh, then you must be the owner of
    -- the virtual gateway resource.
    CreateGatewayRoute -> Text
virtualGatewayName :: Prelude.Text
  }
  deriving (CreateGatewayRoute -> CreateGatewayRoute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGatewayRoute -> CreateGatewayRoute -> Bool
$c/= :: CreateGatewayRoute -> CreateGatewayRoute -> Bool
== :: CreateGatewayRoute -> CreateGatewayRoute -> Bool
$c== :: CreateGatewayRoute -> CreateGatewayRoute -> Bool
Prelude.Eq, ReadPrec [CreateGatewayRoute]
ReadPrec CreateGatewayRoute
Int -> ReadS CreateGatewayRoute
ReadS [CreateGatewayRoute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGatewayRoute]
$creadListPrec :: ReadPrec [CreateGatewayRoute]
readPrec :: ReadPrec CreateGatewayRoute
$creadPrec :: ReadPrec CreateGatewayRoute
readList :: ReadS [CreateGatewayRoute]
$creadList :: ReadS [CreateGatewayRoute]
readsPrec :: Int -> ReadS CreateGatewayRoute
$creadsPrec :: Int -> ReadS CreateGatewayRoute
Prelude.Read, Int -> CreateGatewayRoute -> ShowS
[CreateGatewayRoute] -> ShowS
CreateGatewayRoute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGatewayRoute] -> ShowS
$cshowList :: [CreateGatewayRoute] -> ShowS
show :: CreateGatewayRoute -> String
$cshow :: CreateGatewayRoute -> String
showsPrec :: Int -> CreateGatewayRoute -> ShowS
$cshowsPrec :: Int -> CreateGatewayRoute -> ShowS
Prelude.Show, forall x. Rep CreateGatewayRoute x -> CreateGatewayRoute
forall x. CreateGatewayRoute -> Rep CreateGatewayRoute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateGatewayRoute x -> CreateGatewayRoute
$cfrom :: forall x. CreateGatewayRoute -> Rep CreateGatewayRoute x
Prelude.Generic)

-- |
-- Create a value of 'CreateGatewayRoute' 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:
--
-- 'clientToken', 'createGatewayRoute_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Up to 36 letters, numbers, hyphens, and
-- underscores are allowed.
--
-- 'meshOwner', 'createGatewayRoute_meshOwner' - The Amazon Web Services IAM account ID of the service mesh owner. If the
-- account ID is not your own, then the account that you specify must share
-- the mesh with your account before you can create the resource in the
-- service mesh. For more information about mesh sharing, see
-- <https://docs.aws.amazon.com/app-mesh/latest/userguide/sharing.html Working with shared meshes>.
--
-- 'tags', 'createGatewayRoute_tags' - Optional metadata that you can apply to the gateway route to assist with
-- categorization and organization. Each tag consists of a key and an
-- optional value, both of which you define. Tag keys can have a maximum
-- character length of 128 characters, and tag values can have a maximum
-- length of 256 characters.
--
-- 'gatewayRouteName', 'createGatewayRoute_gatewayRouteName' - The name to use for the gateway route.
--
-- 'meshName', 'createGatewayRoute_meshName' - The name of the service mesh to create the gateway route in.
--
-- 'spec', 'createGatewayRoute_spec' - The gateway route specification to apply.
--
-- 'virtualGatewayName', 'createGatewayRoute_virtualGatewayName' - The name of the virtual gateway to associate the gateway route with. If
-- the virtual gateway is in a shared mesh, then you must be the owner of
-- the virtual gateway resource.
newCreateGatewayRoute ::
  -- | 'gatewayRouteName'
  Prelude.Text ->
  -- | 'meshName'
  Prelude.Text ->
  -- | 'spec'
  GatewayRouteSpec ->
  -- | 'virtualGatewayName'
  Prelude.Text ->
  CreateGatewayRoute
newCreateGatewayRoute :: Text -> Text -> GatewayRouteSpec -> Text -> CreateGatewayRoute
newCreateGatewayRoute
  Text
pGatewayRouteName_
  Text
pMeshName_
  GatewayRouteSpec
pSpec_
  Text
pVirtualGatewayName_ =
    CreateGatewayRoute'
      { $sel:clientToken:CreateGatewayRoute' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:meshOwner:CreateGatewayRoute' :: Maybe Text
meshOwner = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateGatewayRoute' :: Maybe [TagRef]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:gatewayRouteName:CreateGatewayRoute' :: Text
gatewayRouteName = Text
pGatewayRouteName_,
        $sel:meshName:CreateGatewayRoute' :: Text
meshName = Text
pMeshName_,
        $sel:spec:CreateGatewayRoute' :: GatewayRouteSpec
spec = GatewayRouteSpec
pSpec_,
        $sel:virtualGatewayName:CreateGatewayRoute' :: Text
virtualGatewayName = Text
pVirtualGatewayName_
      }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Up to 36 letters, numbers, hyphens, and
-- underscores are allowed.
createGatewayRoute_clientToken :: Lens.Lens' CreateGatewayRoute (Prelude.Maybe Prelude.Text)
createGatewayRoute_clientToken :: Lens' CreateGatewayRoute (Maybe Text)
createGatewayRoute_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayRoute' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateGatewayRoute
s@CreateGatewayRoute' {} Maybe Text
a -> CreateGatewayRoute
s {$sel:clientToken:CreateGatewayRoute' :: Maybe Text
clientToken = Maybe Text
a} :: CreateGatewayRoute)

-- | The Amazon Web Services IAM account ID of the service mesh owner. If the
-- account ID is not your own, then the account that you specify must share
-- the mesh with your account before you can create the resource in the
-- service mesh. For more information about mesh sharing, see
-- <https://docs.aws.amazon.com/app-mesh/latest/userguide/sharing.html Working with shared meshes>.
createGatewayRoute_meshOwner :: Lens.Lens' CreateGatewayRoute (Prelude.Maybe Prelude.Text)
createGatewayRoute_meshOwner :: Lens' CreateGatewayRoute (Maybe Text)
createGatewayRoute_meshOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayRoute' {Maybe Text
meshOwner :: Maybe Text
$sel:meshOwner:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
meshOwner} -> Maybe Text
meshOwner) (\s :: CreateGatewayRoute
s@CreateGatewayRoute' {} Maybe Text
a -> CreateGatewayRoute
s {$sel:meshOwner:CreateGatewayRoute' :: Maybe Text
meshOwner = Maybe Text
a} :: CreateGatewayRoute)

-- | Optional metadata that you can apply to the gateway route to assist with
-- categorization and organization. Each tag consists of a key and an
-- optional value, both of which you define. Tag keys can have a maximum
-- character length of 128 characters, and tag values can have a maximum
-- length of 256 characters.
createGatewayRoute_tags :: Lens.Lens' CreateGatewayRoute (Prelude.Maybe [TagRef])
createGatewayRoute_tags :: Lens' CreateGatewayRoute (Maybe [TagRef])
createGatewayRoute_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayRoute' {Maybe [TagRef]
tags :: Maybe [TagRef]
$sel:tags:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe [TagRef]
tags} -> Maybe [TagRef]
tags) (\s :: CreateGatewayRoute
s@CreateGatewayRoute' {} Maybe [TagRef]
a -> CreateGatewayRoute
s {$sel:tags:CreateGatewayRoute' :: Maybe [TagRef]
tags = Maybe [TagRef]
a} :: CreateGatewayRoute) 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

-- | The name to use for the gateway route.
createGatewayRoute_gatewayRouteName :: Lens.Lens' CreateGatewayRoute Prelude.Text
createGatewayRoute_gatewayRouteName :: Lens' CreateGatewayRoute Text
createGatewayRoute_gatewayRouteName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayRoute' {Text
gatewayRouteName :: Text
$sel:gatewayRouteName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
gatewayRouteName} -> Text
gatewayRouteName) (\s :: CreateGatewayRoute
s@CreateGatewayRoute' {} Text
a -> CreateGatewayRoute
s {$sel:gatewayRouteName:CreateGatewayRoute' :: Text
gatewayRouteName = Text
a} :: CreateGatewayRoute)

-- | The name of the service mesh to create the gateway route in.
createGatewayRoute_meshName :: Lens.Lens' CreateGatewayRoute Prelude.Text
createGatewayRoute_meshName :: Lens' CreateGatewayRoute Text
createGatewayRoute_meshName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayRoute' {Text
meshName :: Text
$sel:meshName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
meshName} -> Text
meshName) (\s :: CreateGatewayRoute
s@CreateGatewayRoute' {} Text
a -> CreateGatewayRoute
s {$sel:meshName:CreateGatewayRoute' :: Text
meshName = Text
a} :: CreateGatewayRoute)

-- | The gateway route specification to apply.
createGatewayRoute_spec :: Lens.Lens' CreateGatewayRoute GatewayRouteSpec
createGatewayRoute_spec :: Lens' CreateGatewayRoute GatewayRouteSpec
createGatewayRoute_spec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayRoute' {GatewayRouteSpec
spec :: GatewayRouteSpec
$sel:spec:CreateGatewayRoute' :: CreateGatewayRoute -> GatewayRouteSpec
spec} -> GatewayRouteSpec
spec) (\s :: CreateGatewayRoute
s@CreateGatewayRoute' {} GatewayRouteSpec
a -> CreateGatewayRoute
s {$sel:spec:CreateGatewayRoute' :: GatewayRouteSpec
spec = GatewayRouteSpec
a} :: CreateGatewayRoute)

-- | The name of the virtual gateway to associate the gateway route with. If
-- the virtual gateway is in a shared mesh, then you must be the owner of
-- the virtual gateway resource.
createGatewayRoute_virtualGatewayName :: Lens.Lens' CreateGatewayRoute Prelude.Text
createGatewayRoute_virtualGatewayName :: Lens' CreateGatewayRoute Text
createGatewayRoute_virtualGatewayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayRoute' {Text
virtualGatewayName :: Text
$sel:virtualGatewayName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
virtualGatewayName} -> Text
virtualGatewayName) (\s :: CreateGatewayRoute
s@CreateGatewayRoute' {} Text
a -> CreateGatewayRoute
s {$sel:virtualGatewayName:CreateGatewayRoute' :: Text
virtualGatewayName = Text
a} :: CreateGatewayRoute)

instance Core.AWSRequest CreateGatewayRoute where
  type
    AWSResponse CreateGatewayRoute =
      CreateGatewayRouteResponse
  request :: (Service -> Service)
-> CreateGatewayRoute -> Request CreateGatewayRoute
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateGatewayRoute
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateGatewayRoute)))
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 -> GatewayRouteData -> CreateGatewayRouteResponse
CreateGatewayRouteResponse'
            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.<*> (forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)
      )

instance Prelude.Hashable CreateGatewayRoute where
  hashWithSalt :: Int -> CreateGatewayRoute -> Int
hashWithSalt Int
_salt CreateGatewayRoute' {Maybe [TagRef]
Maybe Text
Text
GatewayRouteSpec
virtualGatewayName :: Text
spec :: GatewayRouteSpec
meshName :: Text
gatewayRouteName :: Text
tags :: Maybe [TagRef]
meshOwner :: Maybe Text
clientToken :: Maybe Text
$sel:virtualGatewayName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:spec:CreateGatewayRoute' :: CreateGatewayRoute -> GatewayRouteSpec
$sel:meshName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:gatewayRouteName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:tags:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe [TagRef]
$sel:meshOwner:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
$sel:clientToken:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
meshOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagRef]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayRouteName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
meshName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` GatewayRouteSpec
spec
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
virtualGatewayName

instance Prelude.NFData CreateGatewayRoute where
  rnf :: CreateGatewayRoute -> ()
rnf CreateGatewayRoute' {Maybe [TagRef]
Maybe Text
Text
GatewayRouteSpec
virtualGatewayName :: Text
spec :: GatewayRouteSpec
meshName :: Text
gatewayRouteName :: Text
tags :: Maybe [TagRef]
meshOwner :: Maybe Text
clientToken :: Maybe Text
$sel:virtualGatewayName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:spec:CreateGatewayRoute' :: CreateGatewayRoute -> GatewayRouteSpec
$sel:meshName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:gatewayRouteName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:tags:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe [TagRef]
$sel:meshOwner:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
$sel:clientToken:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
meshOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagRef]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gatewayRouteName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
meshName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf GatewayRouteSpec
spec
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
virtualGatewayName

instance Data.ToHeaders CreateGatewayRoute where
  toHeaders :: CreateGatewayRoute -> 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 CreateGatewayRoute where
  toJSON :: CreateGatewayRoute -> Value
toJSON CreateGatewayRoute' {Maybe [TagRef]
Maybe Text
Text
GatewayRouteSpec
virtualGatewayName :: Text
spec :: GatewayRouteSpec
meshName :: Text
gatewayRouteName :: Text
tags :: Maybe [TagRef]
meshOwner :: Maybe Text
clientToken :: Maybe Text
$sel:virtualGatewayName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:spec:CreateGatewayRoute' :: CreateGatewayRoute -> GatewayRouteSpec
$sel:meshName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:gatewayRouteName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:tags:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe [TagRef]
$sel:meshOwner:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
$sel:clientToken:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            (Key
"tags" 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 [TagRef]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"gatewayRouteName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gatewayRouteName),
            forall a. a -> Maybe a
Prelude.Just (Key
"spec" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= GatewayRouteSpec
spec)
          ]
      )

instance Data.ToPath CreateGatewayRoute where
  toPath :: CreateGatewayRoute -> ByteString
toPath CreateGatewayRoute' {Maybe [TagRef]
Maybe Text
Text
GatewayRouteSpec
virtualGatewayName :: Text
spec :: GatewayRouteSpec
meshName :: Text
gatewayRouteName :: Text
tags :: Maybe [TagRef]
meshOwner :: Maybe Text
clientToken :: Maybe Text
$sel:virtualGatewayName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:spec:CreateGatewayRoute' :: CreateGatewayRoute -> GatewayRouteSpec
$sel:meshName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:gatewayRouteName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:tags:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe [TagRef]
$sel:meshOwner:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
$sel:clientToken:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v20190125/meshes/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
meshName,
        ByteString
"/virtualGateway/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
virtualGatewayName,
        ByteString
"/gatewayRoutes"
      ]

instance Data.ToQuery CreateGatewayRoute where
  toQuery :: CreateGatewayRoute -> QueryString
toQuery CreateGatewayRoute' {Maybe [TagRef]
Maybe Text
Text
GatewayRouteSpec
virtualGatewayName :: Text
spec :: GatewayRouteSpec
meshName :: Text
gatewayRouteName :: Text
tags :: Maybe [TagRef]
meshOwner :: Maybe Text
clientToken :: Maybe Text
$sel:virtualGatewayName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:spec:CreateGatewayRoute' :: CreateGatewayRoute -> GatewayRouteSpec
$sel:meshName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:gatewayRouteName:CreateGatewayRoute' :: CreateGatewayRoute -> Text
$sel:tags:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe [TagRef]
$sel:meshOwner:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
$sel:clientToken:CreateGatewayRoute' :: CreateGatewayRoute -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"meshOwner" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
meshOwner]

-- | /See:/ 'newCreateGatewayRouteResponse' smart constructor.
data CreateGatewayRouteResponse = CreateGatewayRouteResponse'
  { -- | The response's http status code.
    CreateGatewayRouteResponse -> Int
httpStatus :: Prelude.Int,
    -- | The full description of your gateway route following the create call.
    CreateGatewayRouteResponse -> GatewayRouteData
gatewayRoute :: GatewayRouteData
  }
  deriving (CreateGatewayRouteResponse -> CreateGatewayRouteResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGatewayRouteResponse -> CreateGatewayRouteResponse -> Bool
$c/= :: CreateGatewayRouteResponse -> CreateGatewayRouteResponse -> Bool
== :: CreateGatewayRouteResponse -> CreateGatewayRouteResponse -> Bool
$c== :: CreateGatewayRouteResponse -> CreateGatewayRouteResponse -> Bool
Prelude.Eq, ReadPrec [CreateGatewayRouteResponse]
ReadPrec CreateGatewayRouteResponse
Int -> ReadS CreateGatewayRouteResponse
ReadS [CreateGatewayRouteResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGatewayRouteResponse]
$creadListPrec :: ReadPrec [CreateGatewayRouteResponse]
readPrec :: ReadPrec CreateGatewayRouteResponse
$creadPrec :: ReadPrec CreateGatewayRouteResponse
readList :: ReadS [CreateGatewayRouteResponse]
$creadList :: ReadS [CreateGatewayRouteResponse]
readsPrec :: Int -> ReadS CreateGatewayRouteResponse
$creadsPrec :: Int -> ReadS CreateGatewayRouteResponse
Prelude.Read, Int -> CreateGatewayRouteResponse -> ShowS
[CreateGatewayRouteResponse] -> ShowS
CreateGatewayRouteResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGatewayRouteResponse] -> ShowS
$cshowList :: [CreateGatewayRouteResponse] -> ShowS
show :: CreateGatewayRouteResponse -> String
$cshow :: CreateGatewayRouteResponse -> String
showsPrec :: Int -> CreateGatewayRouteResponse -> ShowS
$cshowsPrec :: Int -> CreateGatewayRouteResponse -> ShowS
Prelude.Show, forall x.
Rep CreateGatewayRouteResponse x -> CreateGatewayRouteResponse
forall x.
CreateGatewayRouteResponse -> Rep CreateGatewayRouteResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateGatewayRouteResponse x -> CreateGatewayRouteResponse
$cfrom :: forall x.
CreateGatewayRouteResponse -> Rep CreateGatewayRouteResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateGatewayRouteResponse' 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', 'createGatewayRouteResponse_httpStatus' - The response's http status code.
--
-- 'gatewayRoute', 'createGatewayRouteResponse_gatewayRoute' - The full description of your gateway route following the create call.
newCreateGatewayRouteResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'gatewayRoute'
  GatewayRouteData ->
  CreateGatewayRouteResponse
newCreateGatewayRouteResponse :: Int -> GatewayRouteData -> CreateGatewayRouteResponse
newCreateGatewayRouteResponse
  Int
pHttpStatus_
  GatewayRouteData
pGatewayRoute_ =
    CreateGatewayRouteResponse'
      { $sel:httpStatus:CreateGatewayRouteResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:gatewayRoute:CreateGatewayRouteResponse' :: GatewayRouteData
gatewayRoute = GatewayRouteData
pGatewayRoute_
      }

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

-- | The full description of your gateway route following the create call.
createGatewayRouteResponse_gatewayRoute :: Lens.Lens' CreateGatewayRouteResponse GatewayRouteData
createGatewayRouteResponse_gatewayRoute :: Lens' CreateGatewayRouteResponse GatewayRouteData
createGatewayRouteResponse_gatewayRoute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayRouteResponse' {GatewayRouteData
gatewayRoute :: GatewayRouteData
$sel:gatewayRoute:CreateGatewayRouteResponse' :: CreateGatewayRouteResponse -> GatewayRouteData
gatewayRoute} -> GatewayRouteData
gatewayRoute) (\s :: CreateGatewayRouteResponse
s@CreateGatewayRouteResponse' {} GatewayRouteData
a -> CreateGatewayRouteResponse
s {$sel:gatewayRoute:CreateGatewayRouteResponse' :: GatewayRouteData
gatewayRoute = GatewayRouteData
a} :: CreateGatewayRouteResponse)

instance Prelude.NFData CreateGatewayRouteResponse where
  rnf :: CreateGatewayRouteResponse -> ()
rnf CreateGatewayRouteResponse' {Int
GatewayRouteData
gatewayRoute :: GatewayRouteData
httpStatus :: Int
$sel:gatewayRoute:CreateGatewayRouteResponse' :: CreateGatewayRouteResponse -> GatewayRouteData
$sel:httpStatus:CreateGatewayRouteResponse' :: CreateGatewayRouteResponse -> 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 GatewayRouteData
gatewayRoute