{-# 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.ApiGatewayV2.GetApiMapping
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets an API mapping.
module Amazonka.ApiGatewayV2.GetApiMapping
  ( -- * Creating a Request
    GetApiMapping (..),
    newGetApiMapping,

    -- * Request Lenses
    getApiMapping_apiMappingId,
    getApiMapping_domainName,

    -- * Destructuring the Response
    GetApiMappingResponse (..),
    newGetApiMappingResponse,

    -- * Response Lenses
    getApiMappingResponse_apiId,
    getApiMappingResponse_apiMappingId,
    getApiMappingResponse_apiMappingKey,
    getApiMappingResponse_stage,
    getApiMappingResponse_httpStatus,
  )
where

import Amazonka.ApiGatewayV2.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:/ 'newGetApiMapping' smart constructor.
data GetApiMapping = GetApiMapping'
  { -- | The API mapping identifier.
    GetApiMapping -> Text
apiMappingId :: Prelude.Text,
    -- | The domain name.
    GetApiMapping -> Text
domainName :: Prelude.Text
  }
  deriving (GetApiMapping -> GetApiMapping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApiMapping -> GetApiMapping -> Bool
$c/= :: GetApiMapping -> GetApiMapping -> Bool
== :: GetApiMapping -> GetApiMapping -> Bool
$c== :: GetApiMapping -> GetApiMapping -> Bool
Prelude.Eq, ReadPrec [GetApiMapping]
ReadPrec GetApiMapping
Int -> ReadS GetApiMapping
ReadS [GetApiMapping]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApiMapping]
$creadListPrec :: ReadPrec [GetApiMapping]
readPrec :: ReadPrec GetApiMapping
$creadPrec :: ReadPrec GetApiMapping
readList :: ReadS [GetApiMapping]
$creadList :: ReadS [GetApiMapping]
readsPrec :: Int -> ReadS GetApiMapping
$creadsPrec :: Int -> ReadS GetApiMapping
Prelude.Read, Int -> GetApiMapping -> ShowS
[GetApiMapping] -> ShowS
GetApiMapping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApiMapping] -> ShowS
$cshowList :: [GetApiMapping] -> ShowS
show :: GetApiMapping -> String
$cshow :: GetApiMapping -> String
showsPrec :: Int -> GetApiMapping -> ShowS
$cshowsPrec :: Int -> GetApiMapping -> ShowS
Prelude.Show, forall x. Rep GetApiMapping x -> GetApiMapping
forall x. GetApiMapping -> Rep GetApiMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApiMapping x -> GetApiMapping
$cfrom :: forall x. GetApiMapping -> Rep GetApiMapping x
Prelude.Generic)

-- |
-- Create a value of 'GetApiMapping' 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:
--
-- 'apiMappingId', 'getApiMapping_apiMappingId' - The API mapping identifier.
--
-- 'domainName', 'getApiMapping_domainName' - The domain name.
newGetApiMapping ::
  -- | 'apiMappingId'
  Prelude.Text ->
  -- | 'domainName'
  Prelude.Text ->
  GetApiMapping
newGetApiMapping :: Text -> Text -> GetApiMapping
newGetApiMapping Text
pApiMappingId_ Text
pDomainName_ =
  GetApiMapping'
    { $sel:apiMappingId:GetApiMapping' :: Text
apiMappingId = Text
pApiMappingId_,
      $sel:domainName:GetApiMapping' :: Text
domainName = Text
pDomainName_
    }

-- | The API mapping identifier.
getApiMapping_apiMappingId :: Lens.Lens' GetApiMapping Prelude.Text
getApiMapping_apiMappingId :: Lens' GetApiMapping Text
getApiMapping_apiMappingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiMapping' {Text
apiMappingId :: Text
$sel:apiMappingId:GetApiMapping' :: GetApiMapping -> Text
apiMappingId} -> Text
apiMappingId) (\s :: GetApiMapping
s@GetApiMapping' {} Text
a -> GetApiMapping
s {$sel:apiMappingId:GetApiMapping' :: Text
apiMappingId = Text
a} :: GetApiMapping)

-- | The domain name.
getApiMapping_domainName :: Lens.Lens' GetApiMapping Prelude.Text
getApiMapping_domainName :: Lens' GetApiMapping Text
getApiMapping_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiMapping' {Text
domainName :: Text
$sel:domainName:GetApiMapping' :: GetApiMapping -> Text
domainName} -> Text
domainName) (\s :: GetApiMapping
s@GetApiMapping' {} Text
a -> GetApiMapping
s {$sel:domainName:GetApiMapping' :: Text
domainName = Text
a} :: GetApiMapping)

instance Core.AWSRequest GetApiMapping where
  type
    AWSResponse GetApiMapping =
      GetApiMappingResponse
  request :: (Service -> Service) -> GetApiMapping -> Request GetApiMapping
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetApiMapping
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetApiMapping)))
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 ->
          Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> GetApiMappingResponse
GetApiMappingResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"apiId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"apiMappingId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"apiMappingKey")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"stage")
            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 GetApiMapping where
  hashWithSalt :: Int -> GetApiMapping -> Int
hashWithSalt Int
_salt GetApiMapping' {Text
domainName :: Text
apiMappingId :: Text
$sel:domainName:GetApiMapping' :: GetApiMapping -> Text
$sel:apiMappingId:GetApiMapping' :: GetApiMapping -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiMappingId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData GetApiMapping where
  rnf :: GetApiMapping -> ()
rnf GetApiMapping' {Text
domainName :: Text
apiMappingId :: Text
$sel:domainName:GetApiMapping' :: GetApiMapping -> Text
$sel:apiMappingId:GetApiMapping' :: GetApiMapping -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
apiMappingId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

instance Data.ToHeaders GetApiMapping where
  toHeaders :: GetApiMapping -> 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.ToPath GetApiMapping where
  toPath :: GetApiMapping -> ByteString
toPath GetApiMapping' {Text
domainName :: Text
apiMappingId :: Text
$sel:domainName:GetApiMapping' :: GetApiMapping -> Text
$sel:apiMappingId:GetApiMapping' :: GetApiMapping -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v2/domainnames/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
        ByteString
"/apimappings/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiMappingId
      ]

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

-- | /See:/ 'newGetApiMappingResponse' smart constructor.
data GetApiMappingResponse = GetApiMappingResponse'
  { -- | The API identifier.
    GetApiMappingResponse -> Maybe Text
apiId :: Prelude.Maybe Prelude.Text,
    -- | The API mapping identifier.
    GetApiMappingResponse -> Maybe Text
apiMappingId :: Prelude.Maybe Prelude.Text,
    -- | The API mapping key.
    GetApiMappingResponse -> Maybe Text
apiMappingKey :: Prelude.Maybe Prelude.Text,
    -- | The API stage.
    GetApiMappingResponse -> Maybe Text
stage :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetApiMappingResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetApiMappingResponse -> GetApiMappingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApiMappingResponse -> GetApiMappingResponse -> Bool
$c/= :: GetApiMappingResponse -> GetApiMappingResponse -> Bool
== :: GetApiMappingResponse -> GetApiMappingResponse -> Bool
$c== :: GetApiMappingResponse -> GetApiMappingResponse -> Bool
Prelude.Eq, ReadPrec [GetApiMappingResponse]
ReadPrec GetApiMappingResponse
Int -> ReadS GetApiMappingResponse
ReadS [GetApiMappingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApiMappingResponse]
$creadListPrec :: ReadPrec [GetApiMappingResponse]
readPrec :: ReadPrec GetApiMappingResponse
$creadPrec :: ReadPrec GetApiMappingResponse
readList :: ReadS [GetApiMappingResponse]
$creadList :: ReadS [GetApiMappingResponse]
readsPrec :: Int -> ReadS GetApiMappingResponse
$creadsPrec :: Int -> ReadS GetApiMappingResponse
Prelude.Read, Int -> GetApiMappingResponse -> ShowS
[GetApiMappingResponse] -> ShowS
GetApiMappingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApiMappingResponse] -> ShowS
$cshowList :: [GetApiMappingResponse] -> ShowS
show :: GetApiMappingResponse -> String
$cshow :: GetApiMappingResponse -> String
showsPrec :: Int -> GetApiMappingResponse -> ShowS
$cshowsPrec :: Int -> GetApiMappingResponse -> ShowS
Prelude.Show, forall x. Rep GetApiMappingResponse x -> GetApiMappingResponse
forall x. GetApiMappingResponse -> Rep GetApiMappingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApiMappingResponse x -> GetApiMappingResponse
$cfrom :: forall x. GetApiMappingResponse -> Rep GetApiMappingResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetApiMappingResponse' 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:
--
-- 'apiId', 'getApiMappingResponse_apiId' - The API identifier.
--
-- 'apiMappingId', 'getApiMappingResponse_apiMappingId' - The API mapping identifier.
--
-- 'apiMappingKey', 'getApiMappingResponse_apiMappingKey' - The API mapping key.
--
-- 'stage', 'getApiMappingResponse_stage' - The API stage.
--
-- 'httpStatus', 'getApiMappingResponse_httpStatus' - The response's http status code.
newGetApiMappingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetApiMappingResponse
newGetApiMappingResponse :: Int -> GetApiMappingResponse
newGetApiMappingResponse Int
pHttpStatus_ =
  GetApiMappingResponse'
    { $sel:apiId:GetApiMappingResponse' :: Maybe Text
apiId = forall a. Maybe a
Prelude.Nothing,
      $sel:apiMappingId:GetApiMappingResponse' :: Maybe Text
apiMappingId = forall a. Maybe a
Prelude.Nothing,
      $sel:apiMappingKey:GetApiMappingResponse' :: Maybe Text
apiMappingKey = forall a. Maybe a
Prelude.Nothing,
      $sel:stage:GetApiMappingResponse' :: Maybe Text
stage = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetApiMappingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The API identifier.
getApiMappingResponse_apiId :: Lens.Lens' GetApiMappingResponse (Prelude.Maybe Prelude.Text)
getApiMappingResponse_apiId :: Lens' GetApiMappingResponse (Maybe Text)
getApiMappingResponse_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiMappingResponse' {Maybe Text
apiId :: Maybe Text
$sel:apiId:GetApiMappingResponse' :: GetApiMappingResponse -> Maybe Text
apiId} -> Maybe Text
apiId) (\s :: GetApiMappingResponse
s@GetApiMappingResponse' {} Maybe Text
a -> GetApiMappingResponse
s {$sel:apiId:GetApiMappingResponse' :: Maybe Text
apiId = Maybe Text
a} :: GetApiMappingResponse)

-- | The API mapping identifier.
getApiMappingResponse_apiMappingId :: Lens.Lens' GetApiMappingResponse (Prelude.Maybe Prelude.Text)
getApiMappingResponse_apiMappingId :: Lens' GetApiMappingResponse (Maybe Text)
getApiMappingResponse_apiMappingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiMappingResponse' {Maybe Text
apiMappingId :: Maybe Text
$sel:apiMappingId:GetApiMappingResponse' :: GetApiMappingResponse -> Maybe Text
apiMappingId} -> Maybe Text
apiMappingId) (\s :: GetApiMappingResponse
s@GetApiMappingResponse' {} Maybe Text
a -> GetApiMappingResponse
s {$sel:apiMappingId:GetApiMappingResponse' :: Maybe Text
apiMappingId = Maybe Text
a} :: GetApiMappingResponse)

-- | The API mapping key.
getApiMappingResponse_apiMappingKey :: Lens.Lens' GetApiMappingResponse (Prelude.Maybe Prelude.Text)
getApiMappingResponse_apiMappingKey :: Lens' GetApiMappingResponse (Maybe Text)
getApiMappingResponse_apiMappingKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiMappingResponse' {Maybe Text
apiMappingKey :: Maybe Text
$sel:apiMappingKey:GetApiMappingResponse' :: GetApiMappingResponse -> Maybe Text
apiMappingKey} -> Maybe Text
apiMappingKey) (\s :: GetApiMappingResponse
s@GetApiMappingResponse' {} Maybe Text
a -> GetApiMappingResponse
s {$sel:apiMappingKey:GetApiMappingResponse' :: Maybe Text
apiMappingKey = Maybe Text
a} :: GetApiMappingResponse)

-- | The API stage.
getApiMappingResponse_stage :: Lens.Lens' GetApiMappingResponse (Prelude.Maybe Prelude.Text)
getApiMappingResponse_stage :: Lens' GetApiMappingResponse (Maybe Text)
getApiMappingResponse_stage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiMappingResponse' {Maybe Text
stage :: Maybe Text
$sel:stage:GetApiMappingResponse' :: GetApiMappingResponse -> Maybe Text
stage} -> Maybe Text
stage) (\s :: GetApiMappingResponse
s@GetApiMappingResponse' {} Maybe Text
a -> GetApiMappingResponse
s {$sel:stage:GetApiMappingResponse' :: Maybe Text
stage = Maybe Text
a} :: GetApiMappingResponse)

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

instance Prelude.NFData GetApiMappingResponse where
  rnf :: GetApiMappingResponse -> ()
rnf GetApiMappingResponse' {Int
Maybe Text
httpStatus :: Int
stage :: Maybe Text
apiMappingKey :: Maybe Text
apiMappingId :: Maybe Text
apiId :: Maybe Text
$sel:httpStatus:GetApiMappingResponse' :: GetApiMappingResponse -> Int
$sel:stage:GetApiMappingResponse' :: GetApiMappingResponse -> Maybe Text
$sel:apiMappingKey:GetApiMappingResponse' :: GetApiMappingResponse -> Maybe Text
$sel:apiMappingId:GetApiMappingResponse' :: GetApiMappingResponse -> Maybe Text
$sel:apiId:GetApiMappingResponse' :: GetApiMappingResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
apiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
apiMappingId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
apiMappingKey
      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 Int
httpStatus