{-# 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.APIGateway.CreateBasePathMapping
-- 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 new BasePathMapping resource.
module Amazonka.APIGateway.CreateBasePathMapping
  ( -- * Creating a Request
    CreateBasePathMapping (..),
    newCreateBasePathMapping,

    -- * Request Lenses
    createBasePathMapping_basePath,
    createBasePathMapping_stage,
    createBasePathMapping_domainName,
    createBasePathMapping_restApiId,

    -- * Destructuring the Response
    BasePathMapping (..),
    newBasePathMapping,

    -- * Response Lenses
    basePathMapping_basePath,
    basePathMapping_restApiId,
    basePathMapping_stage,
  )
where

import Amazonka.APIGateway.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

-- | Requests API Gateway to create a new BasePathMapping resource.
--
-- /See:/ 'newCreateBasePathMapping' smart constructor.
data CreateBasePathMapping = CreateBasePathMapping'
  { -- | The base path name that callers of the API must provide as part of the
    -- URL after the domain name. This value must be unique for all of the
    -- mappings across a single API. Specify \'(none)\' if you do not want
    -- callers to specify a base path name after the domain name.
    CreateBasePathMapping -> Maybe Text
basePath :: Prelude.Maybe Prelude.Text,
    -- | The name of the API\'s stage that you want to use for this mapping.
    -- Specify \'(none)\' if you want callers to explicitly specify the stage
    -- name after any base path name.
    CreateBasePathMapping -> Maybe Text
stage :: Prelude.Maybe Prelude.Text,
    -- | The domain name of the BasePathMapping resource to create.
    CreateBasePathMapping -> Text
domainName :: Prelude.Text,
    -- | The string identifier of the associated RestApi.
    CreateBasePathMapping -> Text
restApiId :: Prelude.Text
  }
  deriving (CreateBasePathMapping -> CreateBasePathMapping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBasePathMapping -> CreateBasePathMapping -> Bool
$c/= :: CreateBasePathMapping -> CreateBasePathMapping -> Bool
== :: CreateBasePathMapping -> CreateBasePathMapping -> Bool
$c== :: CreateBasePathMapping -> CreateBasePathMapping -> Bool
Prelude.Eq, ReadPrec [CreateBasePathMapping]
ReadPrec CreateBasePathMapping
Int -> ReadS CreateBasePathMapping
ReadS [CreateBasePathMapping]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBasePathMapping]
$creadListPrec :: ReadPrec [CreateBasePathMapping]
readPrec :: ReadPrec CreateBasePathMapping
$creadPrec :: ReadPrec CreateBasePathMapping
readList :: ReadS [CreateBasePathMapping]
$creadList :: ReadS [CreateBasePathMapping]
readsPrec :: Int -> ReadS CreateBasePathMapping
$creadsPrec :: Int -> ReadS CreateBasePathMapping
Prelude.Read, Int -> CreateBasePathMapping -> ShowS
[CreateBasePathMapping] -> ShowS
CreateBasePathMapping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBasePathMapping] -> ShowS
$cshowList :: [CreateBasePathMapping] -> ShowS
show :: CreateBasePathMapping -> String
$cshow :: CreateBasePathMapping -> String
showsPrec :: Int -> CreateBasePathMapping -> ShowS
$cshowsPrec :: Int -> CreateBasePathMapping -> ShowS
Prelude.Show, forall x. Rep CreateBasePathMapping x -> CreateBasePathMapping
forall x. CreateBasePathMapping -> Rep CreateBasePathMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBasePathMapping x -> CreateBasePathMapping
$cfrom :: forall x. CreateBasePathMapping -> Rep CreateBasePathMapping x
Prelude.Generic)

-- |
-- Create a value of 'CreateBasePathMapping' 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:
--
-- 'basePath', 'createBasePathMapping_basePath' - The base path name that callers of the API must provide as part of the
-- URL after the domain name. This value must be unique for all of the
-- mappings across a single API. Specify \'(none)\' if you do not want
-- callers to specify a base path name after the domain name.
--
-- 'stage', 'createBasePathMapping_stage' - The name of the API\'s stage that you want to use for this mapping.
-- Specify \'(none)\' if you want callers to explicitly specify the stage
-- name after any base path name.
--
-- 'domainName', 'createBasePathMapping_domainName' - The domain name of the BasePathMapping resource to create.
--
-- 'restApiId', 'createBasePathMapping_restApiId' - The string identifier of the associated RestApi.
newCreateBasePathMapping ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'restApiId'
  Prelude.Text ->
  CreateBasePathMapping
newCreateBasePathMapping :: Text -> Text -> CreateBasePathMapping
newCreateBasePathMapping Text
pDomainName_ Text
pRestApiId_ =
  CreateBasePathMapping'
    { $sel:basePath:CreateBasePathMapping' :: Maybe Text
basePath = forall a. Maybe a
Prelude.Nothing,
      $sel:stage:CreateBasePathMapping' :: Maybe Text
stage = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:CreateBasePathMapping' :: Text
domainName = Text
pDomainName_,
      $sel:restApiId:CreateBasePathMapping' :: Text
restApiId = Text
pRestApiId_
    }

-- | The base path name that callers of the API must provide as part of the
-- URL after the domain name. This value must be unique for all of the
-- mappings across a single API. Specify \'(none)\' if you do not want
-- callers to specify a base path name after the domain name.
createBasePathMapping_basePath :: Lens.Lens' CreateBasePathMapping (Prelude.Maybe Prelude.Text)
createBasePathMapping_basePath :: Lens' CreateBasePathMapping (Maybe Text)
createBasePathMapping_basePath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBasePathMapping' {Maybe Text
basePath :: Maybe Text
$sel:basePath:CreateBasePathMapping' :: CreateBasePathMapping -> Maybe Text
basePath} -> Maybe Text
basePath) (\s :: CreateBasePathMapping
s@CreateBasePathMapping' {} Maybe Text
a -> CreateBasePathMapping
s {$sel:basePath:CreateBasePathMapping' :: Maybe Text
basePath = Maybe Text
a} :: CreateBasePathMapping)

-- | The name of the API\'s stage that you want to use for this mapping.
-- Specify \'(none)\' if you want callers to explicitly specify the stage
-- name after any base path name.
createBasePathMapping_stage :: Lens.Lens' CreateBasePathMapping (Prelude.Maybe Prelude.Text)
createBasePathMapping_stage :: Lens' CreateBasePathMapping (Maybe Text)
createBasePathMapping_stage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBasePathMapping' {Maybe Text
stage :: Maybe Text
$sel:stage:CreateBasePathMapping' :: CreateBasePathMapping -> Maybe Text
stage} -> Maybe Text
stage) (\s :: CreateBasePathMapping
s@CreateBasePathMapping' {} Maybe Text
a -> CreateBasePathMapping
s {$sel:stage:CreateBasePathMapping' :: Maybe Text
stage = Maybe Text
a} :: CreateBasePathMapping)

-- | The domain name of the BasePathMapping resource to create.
createBasePathMapping_domainName :: Lens.Lens' CreateBasePathMapping Prelude.Text
createBasePathMapping_domainName :: Lens' CreateBasePathMapping Text
createBasePathMapping_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBasePathMapping' {Text
domainName :: Text
$sel:domainName:CreateBasePathMapping' :: CreateBasePathMapping -> Text
domainName} -> Text
domainName) (\s :: CreateBasePathMapping
s@CreateBasePathMapping' {} Text
a -> CreateBasePathMapping
s {$sel:domainName:CreateBasePathMapping' :: Text
domainName = Text
a} :: CreateBasePathMapping)

-- | The string identifier of the associated RestApi.
createBasePathMapping_restApiId :: Lens.Lens' CreateBasePathMapping Prelude.Text
createBasePathMapping_restApiId :: Lens' CreateBasePathMapping Text
createBasePathMapping_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBasePathMapping' {Text
restApiId :: Text
$sel:restApiId:CreateBasePathMapping' :: CreateBasePathMapping -> Text
restApiId} -> Text
restApiId) (\s :: CreateBasePathMapping
s@CreateBasePathMapping' {} Text
a -> CreateBasePathMapping
s {$sel:restApiId:CreateBasePathMapping' :: Text
restApiId = Text
a} :: CreateBasePathMapping)

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

instance Prelude.Hashable CreateBasePathMapping where
  hashWithSalt :: Int -> CreateBasePathMapping -> Int
hashWithSalt Int
_salt CreateBasePathMapping' {Maybe Text
Text
restApiId :: Text
domainName :: Text
stage :: Maybe Text
basePath :: Maybe Text
$sel:restApiId:CreateBasePathMapping' :: CreateBasePathMapping -> Text
$sel:domainName:CreateBasePathMapping' :: CreateBasePathMapping -> Text
$sel:stage:CreateBasePathMapping' :: CreateBasePathMapping -> Maybe Text
$sel:basePath:CreateBasePathMapping' :: CreateBasePathMapping -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
basePath
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId

instance Prelude.NFData CreateBasePathMapping where
  rnf :: CreateBasePathMapping -> ()
rnf CreateBasePathMapping' {Maybe Text
Text
restApiId :: Text
domainName :: Text
stage :: Maybe Text
basePath :: Maybe Text
$sel:restApiId:CreateBasePathMapping' :: CreateBasePathMapping -> Text
$sel:domainName:CreateBasePathMapping' :: CreateBasePathMapping -> Text
$sel:stage:CreateBasePathMapping' :: CreateBasePathMapping -> Maybe Text
$sel:basePath:CreateBasePathMapping' :: CreateBasePathMapping -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
basePath
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
restApiId

instance Data.ToHeaders CreateBasePathMapping where
  toHeaders :: CreateBasePathMapping -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Accept"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
          ]
      )

instance Data.ToJSON CreateBasePathMapping where
  toJSON :: CreateBasePathMapping -> Value
toJSON CreateBasePathMapping' {Maybe Text
Text
restApiId :: Text
domainName :: Text
stage :: Maybe Text
basePath :: Maybe Text
$sel:restApiId:CreateBasePathMapping' :: CreateBasePathMapping -> Text
$sel:domainName:CreateBasePathMapping' :: CreateBasePathMapping -> Text
$sel:stage:CreateBasePathMapping' :: CreateBasePathMapping -> Maybe Text
$sel:basePath:CreateBasePathMapping' :: CreateBasePathMapping -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"basePath" 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
basePath,
            (Key
"stage" 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
stage,
            forall a. a -> Maybe a
Prelude.Just (Key
"restApiId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
restApiId)
          ]
      )

instance Data.ToPath CreateBasePathMapping where
  toPath :: CreateBasePathMapping -> ByteString
toPath CreateBasePathMapping' {Maybe Text
Text
restApiId :: Text
domainName :: Text
stage :: Maybe Text
basePath :: Maybe Text
$sel:restApiId:CreateBasePathMapping' :: CreateBasePathMapping -> Text
$sel:domainName:CreateBasePathMapping' :: CreateBasePathMapping -> Text
$sel:stage:CreateBasePathMapping' :: CreateBasePathMapping -> Maybe Text
$sel:basePath:CreateBasePathMapping' :: CreateBasePathMapping -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domainnames/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
        ByteString
"/basepathmappings"
      ]

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