{-# 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.AmplifyUiBuilder.GetMetadata
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns existing metadata for an Amplify app.
module Amazonka.AmplifyUiBuilder.GetMetadata
  ( -- * Creating a Request
    GetMetadata (..),
    newGetMetadata,

    -- * Request Lenses
    getMetadata_appId,
    getMetadata_environmentName,

    -- * Destructuring the Response
    GetMetadataResponse (..),
    newGetMetadataResponse,

    -- * Response Lenses
    getMetadataResponse_httpStatus,
    getMetadataResponse_features,
  )
where

import Amazonka.AmplifyUiBuilder.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:/ 'newGetMetadata' smart constructor.
data GetMetadata = GetMetadata'
  { -- | The unique ID of the Amplify app.
    GetMetadata -> Text
appId :: Prelude.Text,
    -- | The name of the backend environment that is part of the Amplify app.
    GetMetadata -> Text
environmentName :: Prelude.Text
  }
  deriving (GetMetadata -> GetMetadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMetadata -> GetMetadata -> Bool
$c/= :: GetMetadata -> GetMetadata -> Bool
== :: GetMetadata -> GetMetadata -> Bool
$c== :: GetMetadata -> GetMetadata -> Bool
Prelude.Eq, ReadPrec [GetMetadata]
ReadPrec GetMetadata
Int -> ReadS GetMetadata
ReadS [GetMetadata]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMetadata]
$creadListPrec :: ReadPrec [GetMetadata]
readPrec :: ReadPrec GetMetadata
$creadPrec :: ReadPrec GetMetadata
readList :: ReadS [GetMetadata]
$creadList :: ReadS [GetMetadata]
readsPrec :: Int -> ReadS GetMetadata
$creadsPrec :: Int -> ReadS GetMetadata
Prelude.Read, Int -> GetMetadata -> ShowS
[GetMetadata] -> ShowS
GetMetadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMetadata] -> ShowS
$cshowList :: [GetMetadata] -> ShowS
show :: GetMetadata -> String
$cshow :: GetMetadata -> String
showsPrec :: Int -> GetMetadata -> ShowS
$cshowsPrec :: Int -> GetMetadata -> ShowS
Prelude.Show, forall x. Rep GetMetadata x -> GetMetadata
forall x. GetMetadata -> Rep GetMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMetadata x -> GetMetadata
$cfrom :: forall x. GetMetadata -> Rep GetMetadata x
Prelude.Generic)

-- |
-- Create a value of 'GetMetadata' 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:
--
-- 'appId', 'getMetadata_appId' - The unique ID of the Amplify app.
--
-- 'environmentName', 'getMetadata_environmentName' - The name of the backend environment that is part of the Amplify app.
newGetMetadata ::
  -- | 'appId'
  Prelude.Text ->
  -- | 'environmentName'
  Prelude.Text ->
  GetMetadata
newGetMetadata :: Text -> Text -> GetMetadata
newGetMetadata Text
pAppId_ Text
pEnvironmentName_ =
  GetMetadata'
    { $sel:appId:GetMetadata' :: Text
appId = Text
pAppId_,
      $sel:environmentName:GetMetadata' :: Text
environmentName = Text
pEnvironmentName_
    }

-- | The unique ID of the Amplify app.
getMetadata_appId :: Lens.Lens' GetMetadata Prelude.Text
getMetadata_appId :: Lens' GetMetadata Text
getMetadata_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMetadata' {Text
appId :: Text
$sel:appId:GetMetadata' :: GetMetadata -> Text
appId} -> Text
appId) (\s :: GetMetadata
s@GetMetadata' {} Text
a -> GetMetadata
s {$sel:appId:GetMetadata' :: Text
appId = Text
a} :: GetMetadata)

-- | The name of the backend environment that is part of the Amplify app.
getMetadata_environmentName :: Lens.Lens' GetMetadata Prelude.Text
getMetadata_environmentName :: Lens' GetMetadata Text
getMetadata_environmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMetadata' {Text
environmentName :: Text
$sel:environmentName:GetMetadata' :: GetMetadata -> Text
environmentName} -> Text
environmentName) (\s :: GetMetadata
s@GetMetadata' {} Text
a -> GetMetadata
s {$sel:environmentName:GetMetadata' :: Text
environmentName = Text
a} :: GetMetadata)

instance Core.AWSRequest GetMetadata where
  type AWSResponse GetMetadata = GetMetadataResponse
  request :: (Service -> Service) -> GetMetadata -> Request GetMetadata
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 GetMetadata
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMetadata)))
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 -> HashMap Text Text -> GetMetadataResponse
GetMetadataResponse'
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"features" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable GetMetadata where
  hashWithSalt :: Int -> GetMetadata -> Int
hashWithSalt Int
_salt GetMetadata' {Text
environmentName :: Text
appId :: Text
$sel:environmentName:GetMetadata' :: GetMetadata -> Text
$sel:appId:GetMetadata' :: GetMetadata -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
environmentName

instance Prelude.NFData GetMetadata where
  rnf :: GetMetadata -> ()
rnf GetMetadata' {Text
environmentName :: Text
appId :: Text
$sel:environmentName:GetMetadata' :: GetMetadata -> Text
$sel:appId:GetMetadata' :: GetMetadata -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
appId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
environmentName

instance Data.ToHeaders GetMetadata where
  toHeaders :: GetMetadata -> 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 GetMetadata where
  toPath :: GetMetadata -> ByteString
toPath GetMetadata' {Text
environmentName :: Text
appId :: Text
$sel:environmentName:GetMetadata' :: GetMetadata -> Text
$sel:appId:GetMetadata' :: GetMetadata -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/app/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
appId,
        ByteString
"/environment/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
environmentName,
        ByteString
"/metadata"
      ]

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

-- | /See:/ 'newGetMetadataResponse' smart constructor.
data GetMetadataResponse = GetMetadataResponse'
  { -- | The response's http status code.
    GetMetadataResponse -> Int
httpStatus :: Prelude.Int,
    -- | Represents the configuration settings for the features metadata.
    GetMetadataResponse -> HashMap Text Text
features :: Prelude.HashMap Prelude.Text Prelude.Text
  }
  deriving (GetMetadataResponse -> GetMetadataResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMetadataResponse -> GetMetadataResponse -> Bool
$c/= :: GetMetadataResponse -> GetMetadataResponse -> Bool
== :: GetMetadataResponse -> GetMetadataResponse -> Bool
$c== :: GetMetadataResponse -> GetMetadataResponse -> Bool
Prelude.Eq, ReadPrec [GetMetadataResponse]
ReadPrec GetMetadataResponse
Int -> ReadS GetMetadataResponse
ReadS [GetMetadataResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMetadataResponse]
$creadListPrec :: ReadPrec [GetMetadataResponse]
readPrec :: ReadPrec GetMetadataResponse
$creadPrec :: ReadPrec GetMetadataResponse
readList :: ReadS [GetMetadataResponse]
$creadList :: ReadS [GetMetadataResponse]
readsPrec :: Int -> ReadS GetMetadataResponse
$creadsPrec :: Int -> ReadS GetMetadataResponse
Prelude.Read, Int -> GetMetadataResponse -> ShowS
[GetMetadataResponse] -> ShowS
GetMetadataResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMetadataResponse] -> ShowS
$cshowList :: [GetMetadataResponse] -> ShowS
show :: GetMetadataResponse -> String
$cshow :: GetMetadataResponse -> String
showsPrec :: Int -> GetMetadataResponse -> ShowS
$cshowsPrec :: Int -> GetMetadataResponse -> ShowS
Prelude.Show, forall x. Rep GetMetadataResponse x -> GetMetadataResponse
forall x. GetMetadataResponse -> Rep GetMetadataResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMetadataResponse x -> GetMetadataResponse
$cfrom :: forall x. GetMetadataResponse -> Rep GetMetadataResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMetadataResponse' 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', 'getMetadataResponse_httpStatus' - The response's http status code.
--
-- 'features', 'getMetadataResponse_features' - Represents the configuration settings for the features metadata.
newGetMetadataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMetadataResponse
newGetMetadataResponse :: Int -> GetMetadataResponse
newGetMetadataResponse Int
pHttpStatus_ =
  GetMetadataResponse'
    { $sel:httpStatus:GetMetadataResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:features:GetMetadataResponse' :: HashMap Text Text
features = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | Represents the configuration settings for the features metadata.
getMetadataResponse_features :: Lens.Lens' GetMetadataResponse (Prelude.HashMap Prelude.Text Prelude.Text)
getMetadataResponse_features :: Lens' GetMetadataResponse (HashMap Text Text)
getMetadataResponse_features = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMetadataResponse' {HashMap Text Text
features :: HashMap Text Text
$sel:features:GetMetadataResponse' :: GetMetadataResponse -> HashMap Text Text
features} -> HashMap Text Text
features) (\s :: GetMetadataResponse
s@GetMetadataResponse' {} HashMap Text Text
a -> GetMetadataResponse
s {$sel:features:GetMetadataResponse' :: HashMap Text Text
features = HashMap Text Text
a} :: GetMetadataResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData GetMetadataResponse where
  rnf :: GetMetadataResponse -> ()
rnf GetMetadataResponse' {Int
HashMap Text Text
features :: HashMap Text Text
httpStatus :: Int
$sel:features:GetMetadataResponse' :: GetMetadataResponse -> HashMap Text Text
$sel:httpStatus:GetMetadataResponse' :: GetMetadataResponse -> 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 HashMap Text Text
features