{-# 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.CreateMesh
-- 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 service mesh.
--
-- A service mesh is a logical boundary for network traffic between
-- services that are represented by resources within the mesh. After you
-- create your service mesh, you can create virtual services, virtual
-- nodes, virtual routers, and routes to distribute traffic between the
-- applications in your mesh.
--
-- For more information about service meshes, see
-- <https://docs.aws.amazon.com/app-mesh/latest/userguide/meshes.html Service meshes>.
module Amazonka.AppMesh.CreateMesh
  ( -- * Creating a Request
    CreateMesh (..),
    newCreateMesh,

    -- * Request Lenses
    createMesh_clientToken,
    createMesh_spec,
    createMesh_tags,
    createMesh_meshName,

    -- * Destructuring the Response
    CreateMeshResponse (..),
    newCreateMeshResponse,

    -- * Response Lenses
    createMeshResponse_httpStatus,
    createMeshResponse_mesh,
  )
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:/ 'newCreateMesh' smart constructor.
data CreateMesh = CreateMesh'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. Up to 36 letters, numbers, hyphens, and
    -- underscores are allowed.
    CreateMesh -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The service mesh specification to apply.
    CreateMesh -> Maybe MeshSpec
spec :: Prelude.Maybe MeshSpec,
    -- | Optional metadata that you can apply to the service mesh 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.
    CreateMesh -> Maybe [TagRef]
tags :: Prelude.Maybe [TagRef],
    -- | The name to use for the service mesh.
    CreateMesh -> Text
meshName :: Prelude.Text
  }
  deriving (CreateMesh -> CreateMesh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMesh -> CreateMesh -> Bool
$c/= :: CreateMesh -> CreateMesh -> Bool
== :: CreateMesh -> CreateMesh -> Bool
$c== :: CreateMesh -> CreateMesh -> Bool
Prelude.Eq, ReadPrec [CreateMesh]
ReadPrec CreateMesh
Int -> ReadS CreateMesh
ReadS [CreateMesh]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateMesh]
$creadListPrec :: ReadPrec [CreateMesh]
readPrec :: ReadPrec CreateMesh
$creadPrec :: ReadPrec CreateMesh
readList :: ReadS [CreateMesh]
$creadList :: ReadS [CreateMesh]
readsPrec :: Int -> ReadS CreateMesh
$creadsPrec :: Int -> ReadS CreateMesh
Prelude.Read, Int -> CreateMesh -> ShowS
[CreateMesh] -> ShowS
CreateMesh -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMesh] -> ShowS
$cshowList :: [CreateMesh] -> ShowS
show :: CreateMesh -> String
$cshow :: CreateMesh -> String
showsPrec :: Int -> CreateMesh -> ShowS
$cshowsPrec :: Int -> CreateMesh -> ShowS
Prelude.Show, forall x. Rep CreateMesh x -> CreateMesh
forall x. CreateMesh -> Rep CreateMesh x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateMesh x -> CreateMesh
$cfrom :: forall x. CreateMesh -> Rep CreateMesh x
Prelude.Generic)

-- |
-- Create a value of 'CreateMesh' 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', 'createMesh_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.
--
-- 'spec', 'createMesh_spec' - The service mesh specification to apply.
--
-- 'tags', 'createMesh_tags' - Optional metadata that you can apply to the service mesh 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', 'createMesh_meshName' - The name to use for the service mesh.
newCreateMesh ::
  -- | 'meshName'
  Prelude.Text ->
  CreateMesh
newCreateMesh :: Text -> CreateMesh
newCreateMesh Text
pMeshName_ =
  CreateMesh'
    { $sel:clientToken:CreateMesh' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:spec:CreateMesh' :: Maybe MeshSpec
spec = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateMesh' :: Maybe [TagRef]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:meshName:CreateMesh' :: Text
meshName = Text
pMeshName_
    }

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

-- | The service mesh specification to apply.
createMesh_spec :: Lens.Lens' CreateMesh (Prelude.Maybe MeshSpec)
createMesh_spec :: Lens' CreateMesh (Maybe MeshSpec)
createMesh_spec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMesh' {Maybe MeshSpec
spec :: Maybe MeshSpec
$sel:spec:CreateMesh' :: CreateMesh -> Maybe MeshSpec
spec} -> Maybe MeshSpec
spec) (\s :: CreateMesh
s@CreateMesh' {} Maybe MeshSpec
a -> CreateMesh
s {$sel:spec:CreateMesh' :: Maybe MeshSpec
spec = Maybe MeshSpec
a} :: CreateMesh)

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

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

instance Prelude.NFData CreateMesh where
  rnf :: CreateMesh -> ()
rnf CreateMesh' {Maybe [TagRef]
Maybe Text
Maybe MeshSpec
Text
meshName :: Text
tags :: Maybe [TagRef]
spec :: Maybe MeshSpec
clientToken :: Maybe Text
$sel:meshName:CreateMesh' :: CreateMesh -> Text
$sel:tags:CreateMesh' :: CreateMesh -> Maybe [TagRef]
$sel:spec:CreateMesh' :: CreateMesh -> Maybe MeshSpec
$sel:clientToken:CreateMesh' :: CreateMesh -> 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 MeshSpec
spec
      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

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

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

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

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

-- |
-- Create a value of 'CreateMeshResponse' 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', 'createMeshResponse_httpStatus' - The response's http status code.
--
-- 'mesh', 'createMeshResponse_mesh' - The full description of your service mesh following the create call.
newCreateMeshResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'mesh'
  MeshData ->
  CreateMeshResponse
newCreateMeshResponse :: Int -> MeshData -> CreateMeshResponse
newCreateMeshResponse Int
pHttpStatus_ MeshData
pMesh_ =
  CreateMeshResponse'
    { $sel:httpStatus:CreateMeshResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:mesh:CreateMeshResponse' :: MeshData
mesh = MeshData
pMesh_
    }

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

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

instance Prelude.NFData CreateMeshResponse where
  rnf :: CreateMeshResponse -> ()
rnf CreateMeshResponse' {Int
MeshData
mesh :: MeshData
httpStatus :: Int
$sel:mesh:CreateMeshResponse' :: CreateMeshResponse -> MeshData
$sel:httpStatus:CreateMeshResponse' :: CreateMeshResponse -> 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 MeshData
mesh