{-# 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.Evidently.GetFeature
-- 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 the details about one feature. You must already know the feature
-- name. To retrieve a list of features in your account, use
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_ListFeatures.html ListFeatures>.
module Amazonka.Evidently.GetFeature
  ( -- * Creating a Request
    GetFeature (..),
    newGetFeature,

    -- * Request Lenses
    getFeature_feature,
    getFeature_project,

    -- * Destructuring the Response
    GetFeatureResponse (..),
    newGetFeatureResponse,

    -- * Response Lenses
    getFeatureResponse_httpStatus,
    getFeatureResponse_feature,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Evidently.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetFeature' smart constructor.
data GetFeature = GetFeature'
  { -- | The name of the feature that you want to retrieve information for.
    GetFeature -> Text
feature :: Prelude.Text,
    -- | The name or ARN of the project that contains the feature.
    GetFeature -> Text
project :: Prelude.Text
  }
  deriving (GetFeature -> GetFeature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFeature -> GetFeature -> Bool
$c/= :: GetFeature -> GetFeature -> Bool
== :: GetFeature -> GetFeature -> Bool
$c== :: GetFeature -> GetFeature -> Bool
Prelude.Eq, ReadPrec [GetFeature]
ReadPrec GetFeature
Int -> ReadS GetFeature
ReadS [GetFeature]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFeature]
$creadListPrec :: ReadPrec [GetFeature]
readPrec :: ReadPrec GetFeature
$creadPrec :: ReadPrec GetFeature
readList :: ReadS [GetFeature]
$creadList :: ReadS [GetFeature]
readsPrec :: Int -> ReadS GetFeature
$creadsPrec :: Int -> ReadS GetFeature
Prelude.Read, Int -> GetFeature -> ShowS
[GetFeature] -> ShowS
GetFeature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFeature] -> ShowS
$cshowList :: [GetFeature] -> ShowS
show :: GetFeature -> String
$cshow :: GetFeature -> String
showsPrec :: Int -> GetFeature -> ShowS
$cshowsPrec :: Int -> GetFeature -> ShowS
Prelude.Show, forall x. Rep GetFeature x -> GetFeature
forall x. GetFeature -> Rep GetFeature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFeature x -> GetFeature
$cfrom :: forall x. GetFeature -> Rep GetFeature x
Prelude.Generic)

-- |
-- Create a value of 'GetFeature' 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:
--
-- 'feature', 'getFeature_feature' - The name of the feature that you want to retrieve information for.
--
-- 'project', 'getFeature_project' - The name or ARN of the project that contains the feature.
newGetFeature ::
  -- | 'feature'
  Prelude.Text ->
  -- | 'project'
  Prelude.Text ->
  GetFeature
newGetFeature :: Text -> Text -> GetFeature
newGetFeature Text
pFeature_ Text
pProject_ =
  GetFeature'
    { $sel:feature:GetFeature' :: Text
feature = Text
pFeature_,
      $sel:project:GetFeature' :: Text
project = Text
pProject_
    }

-- | The name of the feature that you want to retrieve information for.
getFeature_feature :: Lens.Lens' GetFeature Prelude.Text
getFeature_feature :: Lens' GetFeature Text
getFeature_feature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFeature' {Text
feature :: Text
$sel:feature:GetFeature' :: GetFeature -> Text
feature} -> Text
feature) (\s :: GetFeature
s@GetFeature' {} Text
a -> GetFeature
s {$sel:feature:GetFeature' :: Text
feature = Text
a} :: GetFeature)

-- | The name or ARN of the project that contains the feature.
getFeature_project :: Lens.Lens' GetFeature Prelude.Text
getFeature_project :: Lens' GetFeature Text
getFeature_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFeature' {Text
project :: Text
$sel:project:GetFeature' :: GetFeature -> Text
project} -> Text
project) (\s :: GetFeature
s@GetFeature' {} Text
a -> GetFeature
s {$sel:project:GetFeature' :: Text
project = Text
a} :: GetFeature)

instance Core.AWSRequest GetFeature where
  type AWSResponse GetFeature = GetFeatureResponse
  request :: (Service -> Service) -> GetFeature -> Request GetFeature
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 GetFeature
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetFeature)))
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 -> Feature -> GetFeatureResponse
GetFeatureResponse'
            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 a
Data..:> Key
"feature")
      )

instance Prelude.Hashable GetFeature where
  hashWithSalt :: Int -> GetFeature -> Int
hashWithSalt Int
_salt GetFeature' {Text
project :: Text
feature :: Text
$sel:project:GetFeature' :: GetFeature -> Text
$sel:feature:GetFeature' :: GetFeature -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
feature
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
project

instance Prelude.NFData GetFeature where
  rnf :: GetFeature -> ()
rnf GetFeature' {Text
project :: Text
feature :: Text
$sel:project:GetFeature' :: GetFeature -> Text
$sel:feature:GetFeature' :: GetFeature -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
feature
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
project

instance Data.ToHeaders GetFeature where
  toHeaders :: GetFeature -> 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 GetFeature where
  toPath :: GetFeature -> ByteString
toPath GetFeature' {Text
project :: Text
feature :: Text
$sel:project:GetFeature' :: GetFeature -> Text
$sel:feature:GetFeature' :: GetFeature -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/projects/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
project,
        ByteString
"/features/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
feature
      ]

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

-- | /See:/ 'newGetFeatureResponse' smart constructor.
data GetFeatureResponse = GetFeatureResponse'
  { -- | The response's http status code.
    GetFeatureResponse -> Int
httpStatus :: Prelude.Int,
    -- | A structure containing the configuration details of the feature.
    GetFeatureResponse -> Feature
feature :: Feature
  }
  deriving (GetFeatureResponse -> GetFeatureResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFeatureResponse -> GetFeatureResponse -> Bool
$c/= :: GetFeatureResponse -> GetFeatureResponse -> Bool
== :: GetFeatureResponse -> GetFeatureResponse -> Bool
$c== :: GetFeatureResponse -> GetFeatureResponse -> Bool
Prelude.Eq, ReadPrec [GetFeatureResponse]
ReadPrec GetFeatureResponse
Int -> ReadS GetFeatureResponse
ReadS [GetFeatureResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFeatureResponse]
$creadListPrec :: ReadPrec [GetFeatureResponse]
readPrec :: ReadPrec GetFeatureResponse
$creadPrec :: ReadPrec GetFeatureResponse
readList :: ReadS [GetFeatureResponse]
$creadList :: ReadS [GetFeatureResponse]
readsPrec :: Int -> ReadS GetFeatureResponse
$creadsPrec :: Int -> ReadS GetFeatureResponse
Prelude.Read, Int -> GetFeatureResponse -> ShowS
[GetFeatureResponse] -> ShowS
GetFeatureResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFeatureResponse] -> ShowS
$cshowList :: [GetFeatureResponse] -> ShowS
show :: GetFeatureResponse -> String
$cshow :: GetFeatureResponse -> String
showsPrec :: Int -> GetFeatureResponse -> ShowS
$cshowsPrec :: Int -> GetFeatureResponse -> ShowS
Prelude.Show, forall x. Rep GetFeatureResponse x -> GetFeatureResponse
forall x. GetFeatureResponse -> Rep GetFeatureResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFeatureResponse x -> GetFeatureResponse
$cfrom :: forall x. GetFeatureResponse -> Rep GetFeatureResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetFeatureResponse' 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', 'getFeatureResponse_httpStatus' - The response's http status code.
--
-- 'feature', 'getFeatureResponse_feature' - A structure containing the configuration details of the feature.
newGetFeatureResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'feature'
  Feature ->
  GetFeatureResponse
newGetFeatureResponse :: Int -> Feature -> GetFeatureResponse
newGetFeatureResponse Int
pHttpStatus_ Feature
pFeature_ =
  GetFeatureResponse'
    { $sel:httpStatus:GetFeatureResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:feature:GetFeatureResponse' :: Feature
feature = Feature
pFeature_
    }

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

-- | A structure containing the configuration details of the feature.
getFeatureResponse_feature :: Lens.Lens' GetFeatureResponse Feature
getFeatureResponse_feature :: Lens' GetFeatureResponse Feature
getFeatureResponse_feature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFeatureResponse' {Feature
feature :: Feature
$sel:feature:GetFeatureResponse' :: GetFeatureResponse -> Feature
feature} -> Feature
feature) (\s :: GetFeatureResponse
s@GetFeatureResponse' {} Feature
a -> GetFeatureResponse
s {$sel:feature:GetFeatureResponse' :: Feature
feature = Feature
a} :: GetFeatureResponse)

instance Prelude.NFData GetFeatureResponse where
  rnf :: GetFeatureResponse -> ()
rnf GetFeatureResponse' {Int
Feature
feature :: Feature
httpStatus :: Int
$sel:feature:GetFeatureResponse' :: GetFeatureResponse -> Feature
$sel:httpStatus:GetFeatureResponse' :: GetFeatureResponse -> 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 Feature
feature