{-# 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.CreateRoute
-- 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 route that is associated with a virtual router.
--
-- You can route several different protocols and define a retry policy for
-- a route. Traffic can be routed to one or more virtual nodes.
--
-- For more information about routes, see
-- <https://docs.aws.amazon.com/app-mesh/latest/userguide/routes.html Routes>.
module Amazonka.AppMesh.CreateRoute
  ( -- * Creating a Request
    CreateRoute (..),
    newCreateRoute,

    -- * Request Lenses
    createRoute_clientToken,
    createRoute_meshOwner,
    createRoute_tags,
    createRoute_meshName,
    createRoute_routeName,
    createRoute_spec,
    createRoute_virtualRouterName,

    -- * Destructuring the Response
    CreateRouteResponse (..),
    newCreateRouteResponse,

    -- * Response Lenses
    createRouteResponse_httpStatus,
    createRouteResponse_route,
  )
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:/ 'newCreateRoute' smart constructor.
data CreateRoute = CreateRoute'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. Up to 36 letters, numbers, hyphens, and
    -- underscores are allowed.
    CreateRoute -> 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>.
    CreateRoute -> Maybe Text
meshOwner :: Prelude.Maybe Prelude.Text,
    -- | Optional metadata that you can apply to the 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.
    CreateRoute -> Maybe [TagRef]
tags :: Prelude.Maybe [TagRef],
    -- | The name of the service mesh to create the route in.
    CreateRoute -> Text
meshName :: Prelude.Text,
    -- | The name to use for the route.
    CreateRoute -> Text
routeName :: Prelude.Text,
    -- | The route specification to apply.
    CreateRoute -> RouteSpec
spec :: RouteSpec,
    -- | The name of the virtual router in which to create the route. If the
    -- virtual router is in a shared mesh, then you must be the owner of the
    -- virtual router resource.
    CreateRoute -> Text
virtualRouterName :: Prelude.Text
  }
  deriving (CreateRoute -> CreateRoute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRoute -> CreateRoute -> Bool
$c/= :: CreateRoute -> CreateRoute -> Bool
== :: CreateRoute -> CreateRoute -> Bool
$c== :: CreateRoute -> CreateRoute -> Bool
Prelude.Eq, ReadPrec [CreateRoute]
ReadPrec CreateRoute
Int -> ReadS CreateRoute
ReadS [CreateRoute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateRoute]
$creadListPrec :: ReadPrec [CreateRoute]
readPrec :: ReadPrec CreateRoute
$creadPrec :: ReadPrec CreateRoute
readList :: ReadS [CreateRoute]
$creadList :: ReadS [CreateRoute]
readsPrec :: Int -> ReadS CreateRoute
$creadsPrec :: Int -> ReadS CreateRoute
Prelude.Read, Int -> CreateRoute -> ShowS
[CreateRoute] -> ShowS
CreateRoute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRoute] -> ShowS
$cshowList :: [CreateRoute] -> ShowS
show :: CreateRoute -> String
$cshow :: CreateRoute -> String
showsPrec :: Int -> CreateRoute -> ShowS
$cshowsPrec :: Int -> CreateRoute -> ShowS
Prelude.Show, forall x. Rep CreateRoute x -> CreateRoute
forall x. CreateRoute -> Rep CreateRoute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateRoute x -> CreateRoute
$cfrom :: forall x. CreateRoute -> Rep CreateRoute x
Prelude.Generic)

-- |
-- Create a value of 'CreateRoute' 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', 'createRoute_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', 'createRoute_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', 'createRoute_tags' - Optional metadata that you can apply to the 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.
--
-- 'meshName', 'createRoute_meshName' - The name of the service mesh to create the route in.
--
-- 'routeName', 'createRoute_routeName' - The name to use for the route.
--
-- 'spec', 'createRoute_spec' - The route specification to apply.
--
-- 'virtualRouterName', 'createRoute_virtualRouterName' - The name of the virtual router in which to create the route. If the
-- virtual router is in a shared mesh, then you must be the owner of the
-- virtual router resource.
newCreateRoute ::
  -- | 'meshName'
  Prelude.Text ->
  -- | 'routeName'
  Prelude.Text ->
  -- | 'spec'
  RouteSpec ->
  -- | 'virtualRouterName'
  Prelude.Text ->
  CreateRoute
newCreateRoute :: Text -> Text -> RouteSpec -> Text -> CreateRoute
newCreateRoute
  Text
pMeshName_
  Text
pRouteName_
  RouteSpec
pSpec_
  Text
pVirtualRouterName_ =
    CreateRoute'
      { $sel:clientToken:CreateRoute' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:meshOwner:CreateRoute' :: Maybe Text
meshOwner = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateRoute' :: Maybe [TagRef]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:meshName:CreateRoute' :: Text
meshName = Text
pMeshName_,
        $sel:routeName:CreateRoute' :: Text
routeName = Text
pRouteName_,
        $sel:spec:CreateRoute' :: RouteSpec
spec = RouteSpec
pSpec_,
        $sel:virtualRouterName:CreateRoute' :: Text
virtualRouterName = Text
pVirtualRouterName_
      }

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

-- | 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>.
createRoute_meshOwner :: Lens.Lens' CreateRoute (Prelude.Maybe Prelude.Text)
createRoute_meshOwner :: Lens' CreateRoute (Maybe Text)
createRoute_meshOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRoute' {Maybe Text
meshOwner :: Maybe Text
$sel:meshOwner:CreateRoute' :: CreateRoute -> Maybe Text
meshOwner} -> Maybe Text
meshOwner) (\s :: CreateRoute
s@CreateRoute' {} Maybe Text
a -> CreateRoute
s {$sel:meshOwner:CreateRoute' :: Maybe Text
meshOwner = Maybe Text
a} :: CreateRoute)

-- | Optional metadata that you can apply to the 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.
createRoute_tags :: Lens.Lens' CreateRoute (Prelude.Maybe [TagRef])
createRoute_tags :: Lens' CreateRoute (Maybe [TagRef])
createRoute_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRoute' {Maybe [TagRef]
tags :: Maybe [TagRef]
$sel:tags:CreateRoute' :: CreateRoute -> Maybe [TagRef]
tags} -> Maybe [TagRef]
tags) (\s :: CreateRoute
s@CreateRoute' {} Maybe [TagRef]
a -> CreateRoute
s {$sel:tags:CreateRoute' :: Maybe [TagRef]
tags = Maybe [TagRef]
a} :: CreateRoute) 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 of the service mesh to create the route in.
createRoute_meshName :: Lens.Lens' CreateRoute Prelude.Text
createRoute_meshName :: Lens' CreateRoute Text
createRoute_meshName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRoute' {Text
meshName :: Text
$sel:meshName:CreateRoute' :: CreateRoute -> Text
meshName} -> Text
meshName) (\s :: CreateRoute
s@CreateRoute' {} Text
a -> CreateRoute
s {$sel:meshName:CreateRoute' :: Text
meshName = Text
a} :: CreateRoute)

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

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

-- | The name of the virtual router in which to create the route. If the
-- virtual router is in a shared mesh, then you must be the owner of the
-- virtual router resource.
createRoute_virtualRouterName :: Lens.Lens' CreateRoute Prelude.Text
createRoute_virtualRouterName :: Lens' CreateRoute Text
createRoute_virtualRouterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRoute' {Text
virtualRouterName :: Text
$sel:virtualRouterName:CreateRoute' :: CreateRoute -> Text
virtualRouterName} -> Text
virtualRouterName) (\s :: CreateRoute
s@CreateRoute' {} Text
a -> CreateRoute
s {$sel:virtualRouterName:CreateRoute' :: Text
virtualRouterName = Text
a} :: CreateRoute)

instance Core.AWSRequest CreateRoute where
  type AWSResponse CreateRoute = CreateRouteResponse
  request :: (Service -> Service) -> CreateRoute -> Request CreateRoute
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 CreateRoute
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateRoute)))
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 -> RouteData -> CreateRouteResponse
CreateRouteResponse'
            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 CreateRoute where
  hashWithSalt :: Int -> CreateRoute -> Int
hashWithSalt Int
_salt CreateRoute' {Maybe [TagRef]
Maybe Text
Text
RouteSpec
virtualRouterName :: Text
spec :: RouteSpec
routeName :: Text
meshName :: Text
tags :: Maybe [TagRef]
meshOwner :: Maybe Text
clientToken :: Maybe Text
$sel:virtualRouterName:CreateRoute' :: CreateRoute -> Text
$sel:spec:CreateRoute' :: CreateRoute -> RouteSpec
$sel:routeName:CreateRoute' :: CreateRoute -> Text
$sel:meshName:CreateRoute' :: CreateRoute -> Text
$sel:tags:CreateRoute' :: CreateRoute -> Maybe [TagRef]
$sel:meshOwner:CreateRoute' :: CreateRoute -> Maybe Text
$sel:clientToken:CreateRoute' :: CreateRoute -> 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
meshName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
routeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RouteSpec
spec
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
virtualRouterName

instance Prelude.NFData CreateRoute where
  rnf :: CreateRoute -> ()
rnf CreateRoute' {Maybe [TagRef]
Maybe Text
Text
RouteSpec
virtualRouterName :: Text
spec :: RouteSpec
routeName :: Text
meshName :: Text
tags :: Maybe [TagRef]
meshOwner :: Maybe Text
clientToken :: Maybe Text
$sel:virtualRouterName:CreateRoute' :: CreateRoute -> Text
$sel:spec:CreateRoute' :: CreateRoute -> RouteSpec
$sel:routeName:CreateRoute' :: CreateRoute -> Text
$sel:meshName:CreateRoute' :: CreateRoute -> Text
$sel:tags:CreateRoute' :: CreateRoute -> Maybe [TagRef]
$sel:meshOwner:CreateRoute' :: CreateRoute -> Maybe Text
$sel:clientToken:CreateRoute' :: CreateRoute -> 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
meshName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
routeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RouteSpec
spec
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
virtualRouterName

instance Data.ToHeaders CreateRoute where
  toHeaders :: CreateRoute -> 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 CreateRoute where
  toJSON :: CreateRoute -> Value
toJSON CreateRoute' {Maybe [TagRef]
Maybe Text
Text
RouteSpec
virtualRouterName :: Text
spec :: RouteSpec
routeName :: Text
meshName :: Text
tags :: Maybe [TagRef]
meshOwner :: Maybe Text
clientToken :: Maybe Text
$sel:virtualRouterName:CreateRoute' :: CreateRoute -> Text
$sel:spec:CreateRoute' :: CreateRoute -> RouteSpec
$sel:routeName:CreateRoute' :: CreateRoute -> Text
$sel:meshName:CreateRoute' :: CreateRoute -> Text
$sel:tags:CreateRoute' :: CreateRoute -> Maybe [TagRef]
$sel:meshOwner:CreateRoute' :: CreateRoute -> Maybe Text
$sel:clientToken:CreateRoute' :: CreateRoute -> 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
"routeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
routeName),
            forall a. a -> Maybe a
Prelude.Just (Key
"spec" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RouteSpec
spec)
          ]
      )

instance Data.ToPath CreateRoute where
  toPath :: CreateRoute -> ByteString
toPath CreateRoute' {Maybe [TagRef]
Maybe Text
Text
RouteSpec
virtualRouterName :: Text
spec :: RouteSpec
routeName :: Text
meshName :: Text
tags :: Maybe [TagRef]
meshOwner :: Maybe Text
clientToken :: Maybe Text
$sel:virtualRouterName:CreateRoute' :: CreateRoute -> Text
$sel:spec:CreateRoute' :: CreateRoute -> RouteSpec
$sel:routeName:CreateRoute' :: CreateRoute -> Text
$sel:meshName:CreateRoute' :: CreateRoute -> Text
$sel:tags:CreateRoute' :: CreateRoute -> Maybe [TagRef]
$sel:meshOwner:CreateRoute' :: CreateRoute -> Maybe Text
$sel:clientToken:CreateRoute' :: CreateRoute -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v20190125/meshes/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
meshName,
        ByteString
"/virtualRouter/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
virtualRouterName,
        ByteString
"/routes"
      ]

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

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

-- |
-- Create a value of 'CreateRouteResponse' 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', 'createRouteResponse_httpStatus' - The response's http status code.
--
-- 'route', 'createRouteResponse_route' - The full description of your mesh following the create call.
newCreateRouteResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'route'
  RouteData ->
  CreateRouteResponse
newCreateRouteResponse :: Int -> RouteData -> CreateRouteResponse
newCreateRouteResponse Int
pHttpStatus_ RouteData
pRoute_ =
  CreateRouteResponse'
    { $sel:httpStatus:CreateRouteResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:route:CreateRouteResponse' :: RouteData
route = RouteData
pRoute_
    }

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

-- | The full description of your mesh following the create call.
createRouteResponse_route :: Lens.Lens' CreateRouteResponse RouteData
createRouteResponse_route :: Lens' CreateRouteResponse RouteData
createRouteResponse_route = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRouteResponse' {RouteData
route :: RouteData
$sel:route:CreateRouteResponse' :: CreateRouteResponse -> RouteData
route} -> RouteData
route) (\s :: CreateRouteResponse
s@CreateRouteResponse' {} RouteData
a -> CreateRouteResponse
s {$sel:route:CreateRouteResponse' :: RouteData
route = RouteData
a} :: CreateRouteResponse)

instance Prelude.NFData CreateRouteResponse where
  rnf :: CreateRouteResponse -> ()
rnf CreateRouteResponse' {Int
RouteData
route :: RouteData
httpStatus :: Int
$sel:route:CreateRouteResponse' :: CreateRouteResponse -> RouteData
$sel:httpStatus:CreateRouteResponse' :: CreateRouteResponse -> 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 RouteData
route