{-# 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.SageMaker.DescribeProject
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the details of a project.
module Amazonka.SageMaker.DescribeProject
  ( -- * Creating a Request
    DescribeProject (..),
    newDescribeProject,

    -- * Request Lenses
    describeProject_projectName,

    -- * Destructuring the Response
    DescribeProjectResponse (..),
    newDescribeProjectResponse,

    -- * Response Lenses
    describeProjectResponse_createdBy,
    describeProjectResponse_lastModifiedBy,
    describeProjectResponse_lastModifiedTime,
    describeProjectResponse_projectDescription,
    describeProjectResponse_serviceCatalogProvisionedProductDetails,
    describeProjectResponse_httpStatus,
    describeProjectResponse_projectArn,
    describeProjectResponse_projectName,
    describeProjectResponse_projectId,
    describeProjectResponse_serviceCatalogProvisioningDetails,
    describeProjectResponse_projectStatus,
    describeProjectResponse_creationTime,
  )
where

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
import Amazonka.SageMaker.Types

-- | /See:/ 'newDescribeProject' smart constructor.
data DescribeProject = DescribeProject'
  { -- | The name of the project to describe.
    DescribeProject -> Text
projectName :: Prelude.Text
  }
  deriving (DescribeProject -> DescribeProject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeProject -> DescribeProject -> Bool
$c/= :: DescribeProject -> DescribeProject -> Bool
== :: DescribeProject -> DescribeProject -> Bool
$c== :: DescribeProject -> DescribeProject -> Bool
Prelude.Eq, ReadPrec [DescribeProject]
ReadPrec DescribeProject
Int -> ReadS DescribeProject
ReadS [DescribeProject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeProject]
$creadListPrec :: ReadPrec [DescribeProject]
readPrec :: ReadPrec DescribeProject
$creadPrec :: ReadPrec DescribeProject
readList :: ReadS [DescribeProject]
$creadList :: ReadS [DescribeProject]
readsPrec :: Int -> ReadS DescribeProject
$creadsPrec :: Int -> ReadS DescribeProject
Prelude.Read, Int -> DescribeProject -> ShowS
[DescribeProject] -> ShowS
DescribeProject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeProject] -> ShowS
$cshowList :: [DescribeProject] -> ShowS
show :: DescribeProject -> String
$cshow :: DescribeProject -> String
showsPrec :: Int -> DescribeProject -> ShowS
$cshowsPrec :: Int -> DescribeProject -> ShowS
Prelude.Show, forall x. Rep DescribeProject x -> DescribeProject
forall x. DescribeProject -> Rep DescribeProject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeProject x -> DescribeProject
$cfrom :: forall x. DescribeProject -> Rep DescribeProject x
Prelude.Generic)

-- |
-- Create a value of 'DescribeProject' 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:
--
-- 'projectName', 'describeProject_projectName' - The name of the project to describe.
newDescribeProject ::
  -- | 'projectName'
  Prelude.Text ->
  DescribeProject
newDescribeProject :: Text -> DescribeProject
newDescribeProject Text
pProjectName_ =
  DescribeProject' {$sel:projectName:DescribeProject' :: Text
projectName = Text
pProjectName_}

-- | The name of the project to describe.
describeProject_projectName :: Lens.Lens' DescribeProject Prelude.Text
describeProject_projectName :: Lens' DescribeProject Text
describeProject_projectName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProject' {Text
projectName :: Text
$sel:projectName:DescribeProject' :: DescribeProject -> Text
projectName} -> Text
projectName) (\s :: DescribeProject
s@DescribeProject' {} Text
a -> DescribeProject
s {$sel:projectName:DescribeProject' :: Text
projectName = Text
a} :: DescribeProject)

instance Core.AWSRequest DescribeProject where
  type
    AWSResponse DescribeProject =
      DescribeProjectResponse
  request :: (Service -> Service) -> DescribeProject -> Request DescribeProject
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 DescribeProject
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeProject)))
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 UserContext
-> Maybe UserContext
-> Maybe POSIX
-> Maybe Text
-> Maybe ServiceCatalogProvisionedProductDetails
-> Int
-> Text
-> Text
-> Text
-> ServiceCatalogProvisioningDetails
-> ProjectStatus
-> POSIX
-> DescribeProjectResponse
DescribeProjectResponse'
            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
"CreatedBy")
            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
"LastModifiedBy")
            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
"LastModifiedTime")
            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
"ProjectDescription")
            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
"ServiceCatalogProvisionedProductDetails"
                        )
            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))
            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
"ProjectArn")
            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
"ProjectName")
            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
"ProjectId")
            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
"ServiceCatalogProvisioningDetails")
            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
"ProjectStatus")
            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
"CreationTime")
      )

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

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

instance Data.ToHeaders DescribeProject where
  toHeaders :: DescribeProject -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"SageMaker.DescribeProject" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DescribeProject where
  toJSON :: DescribeProject -> Value
toJSON DescribeProject' {Text
projectName :: Text
$sel:projectName:DescribeProject' :: DescribeProject -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"ProjectName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
projectName)]
      )

instance Data.ToPath DescribeProject where
  toPath :: DescribeProject -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDescribeProjectResponse' smart constructor.
data DescribeProjectResponse = DescribeProjectResponse'
  { DescribeProjectResponse -> Maybe UserContext
createdBy :: Prelude.Maybe UserContext,
    DescribeProjectResponse -> Maybe UserContext
lastModifiedBy :: Prelude.Maybe UserContext,
    -- | The timestamp when project was last modified.
    DescribeProjectResponse -> Maybe POSIX
lastModifiedTime :: Prelude.Maybe Data.POSIX,
    -- | The description of the project.
    DescribeProjectResponse -> Maybe Text
projectDescription :: Prelude.Maybe Prelude.Text,
    -- | Information about a provisioned service catalog product.
    DescribeProjectResponse
-> Maybe ServiceCatalogProvisionedProductDetails
serviceCatalogProvisionedProductDetails :: Prelude.Maybe ServiceCatalogProvisionedProductDetails,
    -- | The response's http status code.
    DescribeProjectResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the project.
    DescribeProjectResponse -> Text
projectArn :: Prelude.Text,
    -- | The name of the project.
    DescribeProjectResponse -> Text
projectName :: Prelude.Text,
    -- | The ID of the project.
    DescribeProjectResponse -> Text
projectId :: Prelude.Text,
    -- | Information used to provision a service catalog product. For
    -- information, see
    -- <https://docs.aws.amazon.com/servicecatalog/latest/adminguide/introduction.html What is Amazon Web Services Service Catalog>.
    DescribeProjectResponse -> ServiceCatalogProvisioningDetails
serviceCatalogProvisioningDetails :: ServiceCatalogProvisioningDetails,
    -- | The status of the project.
    DescribeProjectResponse -> ProjectStatus
projectStatus :: ProjectStatus,
    -- | The time when the project was created.
    DescribeProjectResponse -> POSIX
creationTime :: Data.POSIX
  }
  deriving (DescribeProjectResponse -> DescribeProjectResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeProjectResponse -> DescribeProjectResponse -> Bool
$c/= :: DescribeProjectResponse -> DescribeProjectResponse -> Bool
== :: DescribeProjectResponse -> DescribeProjectResponse -> Bool
$c== :: DescribeProjectResponse -> DescribeProjectResponse -> Bool
Prelude.Eq, ReadPrec [DescribeProjectResponse]
ReadPrec DescribeProjectResponse
Int -> ReadS DescribeProjectResponse
ReadS [DescribeProjectResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeProjectResponse]
$creadListPrec :: ReadPrec [DescribeProjectResponse]
readPrec :: ReadPrec DescribeProjectResponse
$creadPrec :: ReadPrec DescribeProjectResponse
readList :: ReadS [DescribeProjectResponse]
$creadList :: ReadS [DescribeProjectResponse]
readsPrec :: Int -> ReadS DescribeProjectResponse
$creadsPrec :: Int -> ReadS DescribeProjectResponse
Prelude.Read, Int -> DescribeProjectResponse -> ShowS
[DescribeProjectResponse] -> ShowS
DescribeProjectResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeProjectResponse] -> ShowS
$cshowList :: [DescribeProjectResponse] -> ShowS
show :: DescribeProjectResponse -> String
$cshow :: DescribeProjectResponse -> String
showsPrec :: Int -> DescribeProjectResponse -> ShowS
$cshowsPrec :: Int -> DescribeProjectResponse -> ShowS
Prelude.Show, forall x. Rep DescribeProjectResponse x -> DescribeProjectResponse
forall x. DescribeProjectResponse -> Rep DescribeProjectResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeProjectResponse x -> DescribeProjectResponse
$cfrom :: forall x. DescribeProjectResponse -> Rep DescribeProjectResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeProjectResponse' 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:
--
-- 'createdBy', 'describeProjectResponse_createdBy' - Undocumented member.
--
-- 'lastModifiedBy', 'describeProjectResponse_lastModifiedBy' - Undocumented member.
--
-- 'lastModifiedTime', 'describeProjectResponse_lastModifiedTime' - The timestamp when project was last modified.
--
-- 'projectDescription', 'describeProjectResponse_projectDescription' - The description of the project.
--
-- 'serviceCatalogProvisionedProductDetails', 'describeProjectResponse_serviceCatalogProvisionedProductDetails' - Information about a provisioned service catalog product.
--
-- 'httpStatus', 'describeProjectResponse_httpStatus' - The response's http status code.
--
-- 'projectArn', 'describeProjectResponse_projectArn' - The Amazon Resource Name (ARN) of the project.
--
-- 'projectName', 'describeProjectResponse_projectName' - The name of the project.
--
-- 'projectId', 'describeProjectResponse_projectId' - The ID of the project.
--
-- 'serviceCatalogProvisioningDetails', 'describeProjectResponse_serviceCatalogProvisioningDetails' - Information used to provision a service catalog product. For
-- information, see
-- <https://docs.aws.amazon.com/servicecatalog/latest/adminguide/introduction.html What is Amazon Web Services Service Catalog>.
--
-- 'projectStatus', 'describeProjectResponse_projectStatus' - The status of the project.
--
-- 'creationTime', 'describeProjectResponse_creationTime' - The time when the project was created.
newDescribeProjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'projectArn'
  Prelude.Text ->
  -- | 'projectName'
  Prelude.Text ->
  -- | 'projectId'
  Prelude.Text ->
  -- | 'serviceCatalogProvisioningDetails'
  ServiceCatalogProvisioningDetails ->
  -- | 'projectStatus'
  ProjectStatus ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  DescribeProjectResponse
newDescribeProjectResponse :: Int
-> Text
-> Text
-> Text
-> ServiceCatalogProvisioningDetails
-> ProjectStatus
-> UTCTime
-> DescribeProjectResponse
newDescribeProjectResponse
  Int
pHttpStatus_
  Text
pProjectArn_
  Text
pProjectName_
  Text
pProjectId_
  ServiceCatalogProvisioningDetails
pServiceCatalogProvisioningDetails_
  ProjectStatus
pProjectStatus_
  UTCTime
pCreationTime_ =
    DescribeProjectResponse'
      { $sel:createdBy:DescribeProjectResponse' :: Maybe UserContext
createdBy =
          forall a. Maybe a
Prelude.Nothing,
        $sel:lastModifiedBy:DescribeProjectResponse' :: Maybe UserContext
lastModifiedBy = forall a. Maybe a
Prelude.Nothing,
        $sel:lastModifiedTime:DescribeProjectResponse' :: Maybe POSIX
lastModifiedTime = forall a. Maybe a
Prelude.Nothing,
        $sel:projectDescription:DescribeProjectResponse' :: Maybe Text
projectDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:serviceCatalogProvisionedProductDetails:DescribeProjectResponse' :: Maybe ServiceCatalogProvisionedProductDetails
serviceCatalogProvisionedProductDetails =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeProjectResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:projectArn:DescribeProjectResponse' :: Text
projectArn = Text
pProjectArn_,
        $sel:projectName:DescribeProjectResponse' :: Text
projectName = Text
pProjectName_,
        $sel:projectId:DescribeProjectResponse' :: Text
projectId = Text
pProjectId_,
        $sel:serviceCatalogProvisioningDetails:DescribeProjectResponse' :: ServiceCatalogProvisioningDetails
serviceCatalogProvisioningDetails =
          ServiceCatalogProvisioningDetails
pServiceCatalogProvisioningDetails_,
        $sel:projectStatus:DescribeProjectResponse' :: ProjectStatus
projectStatus = ProjectStatus
pProjectStatus_,
        $sel:creationTime:DescribeProjectResponse' :: POSIX
creationTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_
      }

-- | Undocumented member.
describeProjectResponse_createdBy :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe UserContext)
describeProjectResponse_createdBy :: Lens' DescribeProjectResponse (Maybe UserContext)
describeProjectResponse_createdBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe UserContext
createdBy :: Maybe UserContext
$sel:createdBy:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe UserContext
createdBy} -> Maybe UserContext
createdBy) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe UserContext
a -> DescribeProjectResponse
s {$sel:createdBy:DescribeProjectResponse' :: Maybe UserContext
createdBy = Maybe UserContext
a} :: DescribeProjectResponse)

-- | Undocumented member.
describeProjectResponse_lastModifiedBy :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe UserContext)
describeProjectResponse_lastModifiedBy :: Lens' DescribeProjectResponse (Maybe UserContext)
describeProjectResponse_lastModifiedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe UserContext
lastModifiedBy :: Maybe UserContext
$sel:lastModifiedBy:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe UserContext
lastModifiedBy} -> Maybe UserContext
lastModifiedBy) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe UserContext
a -> DescribeProjectResponse
s {$sel:lastModifiedBy:DescribeProjectResponse' :: Maybe UserContext
lastModifiedBy = Maybe UserContext
a} :: DescribeProjectResponse)

-- | The timestamp when project was last modified.
describeProjectResponse_lastModifiedTime :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe Prelude.UTCTime)
describeProjectResponse_lastModifiedTime :: Lens' DescribeProjectResponse (Maybe UTCTime)
describeProjectResponse_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe POSIX
lastModifiedTime :: Maybe POSIX
$sel:lastModifiedTime:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe POSIX
lastModifiedTime} -> Maybe POSIX
lastModifiedTime) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe POSIX
a -> DescribeProjectResponse
s {$sel:lastModifiedTime:DescribeProjectResponse' :: Maybe POSIX
lastModifiedTime = Maybe POSIX
a} :: DescribeProjectResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The description of the project.
describeProjectResponse_projectDescription :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe Prelude.Text)
describeProjectResponse_projectDescription :: Lens' DescribeProjectResponse (Maybe Text)
describeProjectResponse_projectDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe Text
projectDescription :: Maybe Text
$sel:projectDescription:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
projectDescription} -> Maybe Text
projectDescription) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe Text
a -> DescribeProjectResponse
s {$sel:projectDescription:DescribeProjectResponse' :: Maybe Text
projectDescription = Maybe Text
a} :: DescribeProjectResponse)

-- | Information about a provisioned service catalog product.
describeProjectResponse_serviceCatalogProvisionedProductDetails :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe ServiceCatalogProvisionedProductDetails)
describeProjectResponse_serviceCatalogProvisionedProductDetails :: Lens'
  DescribeProjectResponse
  (Maybe ServiceCatalogProvisionedProductDetails)
describeProjectResponse_serviceCatalogProvisionedProductDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe ServiceCatalogProvisionedProductDetails
serviceCatalogProvisionedProductDetails :: Maybe ServiceCatalogProvisionedProductDetails
$sel:serviceCatalogProvisionedProductDetails:DescribeProjectResponse' :: DescribeProjectResponse
-> Maybe ServiceCatalogProvisionedProductDetails
serviceCatalogProvisionedProductDetails} -> Maybe ServiceCatalogProvisionedProductDetails
serviceCatalogProvisionedProductDetails) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe ServiceCatalogProvisionedProductDetails
a -> DescribeProjectResponse
s {$sel:serviceCatalogProvisionedProductDetails:DescribeProjectResponse' :: Maybe ServiceCatalogProvisionedProductDetails
serviceCatalogProvisionedProductDetails = Maybe ServiceCatalogProvisionedProductDetails
a} :: DescribeProjectResponse)

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

-- | The Amazon Resource Name (ARN) of the project.
describeProjectResponse_projectArn :: Lens.Lens' DescribeProjectResponse Prelude.Text
describeProjectResponse_projectArn :: Lens' DescribeProjectResponse Text
describeProjectResponse_projectArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Text
projectArn :: Text
$sel:projectArn:DescribeProjectResponse' :: DescribeProjectResponse -> Text
projectArn} -> Text
projectArn) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Text
a -> DescribeProjectResponse
s {$sel:projectArn:DescribeProjectResponse' :: Text
projectArn = Text
a} :: DescribeProjectResponse)

-- | The name of the project.
describeProjectResponse_projectName :: Lens.Lens' DescribeProjectResponse Prelude.Text
describeProjectResponse_projectName :: Lens' DescribeProjectResponse Text
describeProjectResponse_projectName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Text
projectName :: Text
$sel:projectName:DescribeProjectResponse' :: DescribeProjectResponse -> Text
projectName} -> Text
projectName) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Text
a -> DescribeProjectResponse
s {$sel:projectName:DescribeProjectResponse' :: Text
projectName = Text
a} :: DescribeProjectResponse)

-- | The ID of the project.
describeProjectResponse_projectId :: Lens.Lens' DescribeProjectResponse Prelude.Text
describeProjectResponse_projectId :: Lens' DescribeProjectResponse Text
describeProjectResponse_projectId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Text
projectId :: Text
$sel:projectId:DescribeProjectResponse' :: DescribeProjectResponse -> Text
projectId} -> Text
projectId) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Text
a -> DescribeProjectResponse
s {$sel:projectId:DescribeProjectResponse' :: Text
projectId = Text
a} :: DescribeProjectResponse)

-- | Information used to provision a service catalog product. For
-- information, see
-- <https://docs.aws.amazon.com/servicecatalog/latest/adminguide/introduction.html What is Amazon Web Services Service Catalog>.
describeProjectResponse_serviceCatalogProvisioningDetails :: Lens.Lens' DescribeProjectResponse ServiceCatalogProvisioningDetails
describeProjectResponse_serviceCatalogProvisioningDetails :: Lens' DescribeProjectResponse ServiceCatalogProvisioningDetails
describeProjectResponse_serviceCatalogProvisioningDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {ServiceCatalogProvisioningDetails
serviceCatalogProvisioningDetails :: ServiceCatalogProvisioningDetails
$sel:serviceCatalogProvisioningDetails:DescribeProjectResponse' :: DescribeProjectResponse -> ServiceCatalogProvisioningDetails
serviceCatalogProvisioningDetails} -> ServiceCatalogProvisioningDetails
serviceCatalogProvisioningDetails) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} ServiceCatalogProvisioningDetails
a -> DescribeProjectResponse
s {$sel:serviceCatalogProvisioningDetails:DescribeProjectResponse' :: ServiceCatalogProvisioningDetails
serviceCatalogProvisioningDetails = ServiceCatalogProvisioningDetails
a} :: DescribeProjectResponse)

-- | The status of the project.
describeProjectResponse_projectStatus :: Lens.Lens' DescribeProjectResponse ProjectStatus
describeProjectResponse_projectStatus :: Lens' DescribeProjectResponse ProjectStatus
describeProjectResponse_projectStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {ProjectStatus
projectStatus :: ProjectStatus
$sel:projectStatus:DescribeProjectResponse' :: DescribeProjectResponse -> ProjectStatus
projectStatus} -> ProjectStatus
projectStatus) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} ProjectStatus
a -> DescribeProjectResponse
s {$sel:projectStatus:DescribeProjectResponse' :: ProjectStatus
projectStatus = ProjectStatus
a} :: DescribeProjectResponse)

-- | The time when the project was created.
describeProjectResponse_creationTime :: Lens.Lens' DescribeProjectResponse Prelude.UTCTime
describeProjectResponse_creationTime :: Lens' DescribeProjectResponse UTCTime
describeProjectResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {POSIX
creationTime :: POSIX
$sel:creationTime:DescribeProjectResponse' :: DescribeProjectResponse -> POSIX
creationTime} -> POSIX
creationTime) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} POSIX
a -> DescribeProjectResponse
s {$sel:creationTime:DescribeProjectResponse' :: POSIX
creationTime = POSIX
a} :: DescribeProjectResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData DescribeProjectResponse where
  rnf :: DescribeProjectResponse -> ()
rnf DescribeProjectResponse' {Int
Maybe Text
Maybe POSIX
Maybe ServiceCatalogProvisionedProductDetails
Maybe UserContext
Text
POSIX
ProjectStatus
ServiceCatalogProvisioningDetails
creationTime :: POSIX
projectStatus :: ProjectStatus
serviceCatalogProvisioningDetails :: ServiceCatalogProvisioningDetails
projectId :: Text
projectName :: Text
projectArn :: Text
httpStatus :: Int
serviceCatalogProvisionedProductDetails :: Maybe ServiceCatalogProvisionedProductDetails
projectDescription :: Maybe Text
lastModifiedTime :: Maybe POSIX
lastModifiedBy :: Maybe UserContext
createdBy :: Maybe UserContext
$sel:creationTime:DescribeProjectResponse' :: DescribeProjectResponse -> POSIX
$sel:projectStatus:DescribeProjectResponse' :: DescribeProjectResponse -> ProjectStatus
$sel:serviceCatalogProvisioningDetails:DescribeProjectResponse' :: DescribeProjectResponse -> ServiceCatalogProvisioningDetails
$sel:projectId:DescribeProjectResponse' :: DescribeProjectResponse -> Text
$sel:projectName:DescribeProjectResponse' :: DescribeProjectResponse -> Text
$sel:projectArn:DescribeProjectResponse' :: DescribeProjectResponse -> Text
$sel:httpStatus:DescribeProjectResponse' :: DescribeProjectResponse -> Int
$sel:serviceCatalogProvisionedProductDetails:DescribeProjectResponse' :: DescribeProjectResponse
-> Maybe ServiceCatalogProvisionedProductDetails
$sel:projectDescription:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
$sel:lastModifiedTime:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe POSIX
$sel:lastModifiedBy:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe UserContext
$sel:createdBy:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe UserContext
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe UserContext
createdBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UserContext
lastModifiedBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
projectDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServiceCatalogProvisionedProductDetails
serviceCatalogProvisionedProductDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
projectArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
projectName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
projectId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ServiceCatalogProvisioningDetails
serviceCatalogProvisioningDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ProjectStatus
projectStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
creationTime