{-# 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.GetProject
-- 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 launch. You must already know the project
-- name. To retrieve a list of projects in your account, use
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_ListProjects.html ListProjects>.
module Amazonka.Evidently.GetProject
  ( -- * Creating a Request
    GetProject (..),
    newGetProject,

    -- * Request Lenses
    getProject_project,

    -- * Destructuring the Response
    GetProjectResponse (..),
    newGetProjectResponse,

    -- * Response Lenses
    getProjectResponse_httpStatus,
    getProjectResponse_project,
  )
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:/ 'newGetProject' smart constructor.
data GetProject = GetProject'
  { -- | The name or ARN of the project that you want to see the details of.
    GetProject -> Text
project :: Prelude.Text
  }
  deriving (GetProject -> GetProject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetProject -> GetProject -> Bool
$c/= :: GetProject -> GetProject -> Bool
== :: GetProject -> GetProject -> Bool
$c== :: GetProject -> GetProject -> Bool
Prelude.Eq, ReadPrec [GetProject]
ReadPrec GetProject
Int -> ReadS GetProject
ReadS [GetProject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetProject]
$creadListPrec :: ReadPrec [GetProject]
readPrec :: ReadPrec GetProject
$creadPrec :: ReadPrec GetProject
readList :: ReadS [GetProject]
$creadList :: ReadS [GetProject]
readsPrec :: Int -> ReadS GetProject
$creadsPrec :: Int -> ReadS GetProject
Prelude.Read, Int -> GetProject -> ShowS
[GetProject] -> ShowS
GetProject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProject] -> ShowS
$cshowList :: [GetProject] -> ShowS
show :: GetProject -> String
$cshow :: GetProject -> String
showsPrec :: Int -> GetProject -> ShowS
$cshowsPrec :: Int -> GetProject -> ShowS
Prelude.Show, forall x. Rep GetProject x -> GetProject
forall x. GetProject -> Rep GetProject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetProject x -> GetProject
$cfrom :: forall x. GetProject -> Rep GetProject x
Prelude.Generic)

-- |
-- Create a value of 'GetProject' 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:
--
-- 'project', 'getProject_project' - The name or ARN of the project that you want to see the details of.
newGetProject ::
  -- | 'project'
  Prelude.Text ->
  GetProject
newGetProject :: Text -> GetProject
newGetProject Text
pProject_ =
  GetProject' {$sel:project:GetProject' :: Text
project = Text
pProject_}

-- | The name or ARN of the project that you want to see the details of.
getProject_project :: Lens.Lens' GetProject Prelude.Text
getProject_project :: Lens' GetProject Text
getProject_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProject' {Text
project :: Text
$sel:project:GetProject' :: GetProject -> Text
project} -> Text
project) (\s :: GetProject
s@GetProject' {} Text
a -> GetProject
s {$sel:project:GetProject' :: Text
project = Text
a} :: GetProject)

instance Core.AWSRequest GetProject where
  type AWSResponse GetProject = GetProjectResponse
  request :: (Service -> Service) -> GetProject -> Request GetProject
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 GetProject
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetProject)))
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 -> Project -> GetProjectResponse
GetProjectResponse'
            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
"project")
      )

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

instance Prelude.NFData GetProject where
  rnf :: GetProject -> ()
rnf GetProject' {Text
project :: Text
$sel:project:GetProject' :: GetProject -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
project

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

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

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

-- |
-- Create a value of 'GetProjectResponse' 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', 'getProjectResponse_httpStatus' - The response's http status code.
--
-- 'project', 'getProjectResponse_project' - A structure containing the configuration details of the project.
newGetProjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'project'
  Project ->
  GetProjectResponse
newGetProjectResponse :: Int -> Project -> GetProjectResponse
newGetProjectResponse Int
pHttpStatus_ Project
pProject_ =
  GetProjectResponse'
    { $sel:httpStatus:GetProjectResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:project:GetProjectResponse' :: Project
project = Project
pProject_
    }

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

-- | A structure containing the configuration details of the project.
getProjectResponse_project :: Lens.Lens' GetProjectResponse Project
getProjectResponse_project :: Lens' GetProjectResponse Project
getProjectResponse_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProjectResponse' {Project
project :: Project
$sel:project:GetProjectResponse' :: GetProjectResponse -> Project
project} -> Project
project) (\s :: GetProjectResponse
s@GetProjectResponse' {} Project
a -> GetProjectResponse
s {$sel:project:GetProjectResponse' :: Project
project = Project
a} :: GetProjectResponse)

instance Prelude.NFData GetProjectResponse where
  rnf :: GetProjectResponse -> ()
rnf GetProjectResponse' {Int
Project
project :: Project
httpStatus :: Int
$sel:project:GetProjectResponse' :: GetProjectResponse -> Project
$sel:httpStatus:GetProjectResponse' :: GetProjectResponse -> 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 Project
project