{-# 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.DataBrew.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)
--
-- Returns the definition of a specific DataBrew project.
module Amazonka.DataBrew.DescribeProject
  ( -- * Creating a Request
    DescribeProject (..),
    newDescribeProject,

    -- * Request Lenses
    describeProject_name,

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

    -- * Response Lenses
    describeProjectResponse_createDate,
    describeProjectResponse_createdBy,
    describeProjectResponse_datasetName,
    describeProjectResponse_lastModifiedBy,
    describeProjectResponse_lastModifiedDate,
    describeProjectResponse_openDate,
    describeProjectResponse_openedBy,
    describeProjectResponse_recipeName,
    describeProjectResponse_resourceArn,
    describeProjectResponse_roleArn,
    describeProjectResponse_sample,
    describeProjectResponse_sessionStatus,
    describeProjectResponse_tags,
    describeProjectResponse_httpStatus,
    describeProjectResponse_name,
  )
where

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

-- | /See:/ 'newDescribeProject' smart constructor.
data DescribeProject = DescribeProject'
  { -- | The name of the project to be described.
    DescribeProject -> Text
name :: 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:
--
-- 'name', 'describeProject_name' - The name of the project to be described.
newDescribeProject ::
  -- | 'name'
  Prelude.Text ->
  DescribeProject
newDescribeProject :: Text -> DescribeProject
newDescribeProject Text
pName_ =
  DescribeProject' {$sel:name:DescribeProject' :: Text
name = Text
pName_}

-- | The name of the project to be described.
describeProject_name :: Lens.Lens' DescribeProject Prelude.Text
describeProject_name :: Lens' DescribeProject Text
describeProject_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProject' {Text
name :: Text
$sel:name:DescribeProject' :: DescribeProject -> Text
name} -> Text
name) (\s :: DescribeProject
s@DescribeProject' {} Text
a -> DescribeProject
s {$sel:name:DescribeProject' :: Text
name = 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 => Service -> a -> Request a
Request.get (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 POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Sample
-> Maybe SessionStatus
-> Maybe (HashMap Text Text)
-> Int
-> Text
-> 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
"CreateDate")
            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
"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
"DatasetName")
            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
"LastModifiedDate")
            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
"OpenDate")
            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
"OpenedBy")
            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
"RecipeName")
            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
"ResourceArn")
            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
"RoleArn")
            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
"Sample")
            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
"SessionStatus")
            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
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"Name")
      )

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

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

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
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DescribeProject where
  toPath :: DescribeProject -> ByteString
toPath DescribeProject' {Text
name :: Text
$sel:name:DescribeProject' :: DescribeProject -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/projects/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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'
  { -- | The date and time that the project was created.
    DescribeProjectResponse -> Maybe POSIX
createDate :: Prelude.Maybe Data.POSIX,
    -- | The identifier (user name) of the user who created the project.
    DescribeProjectResponse -> Maybe Text
createdBy :: Prelude.Maybe Prelude.Text,
    -- | The dataset associated with the project.
    DescribeProjectResponse -> Maybe Text
datasetName :: Prelude.Maybe Prelude.Text,
    -- | The identifier (user name) of the user who last modified the project.
    DescribeProjectResponse -> Maybe Text
lastModifiedBy :: Prelude.Maybe Prelude.Text,
    -- | The date and time that the project was last modified.
    DescribeProjectResponse -> Maybe POSIX
lastModifiedDate :: Prelude.Maybe Data.POSIX,
    -- | The date and time when the project was opened.
    DescribeProjectResponse -> Maybe POSIX
openDate :: Prelude.Maybe Data.POSIX,
    -- | The identifier (user name) of the user that opened the project for use.
    DescribeProjectResponse -> Maybe Text
openedBy :: Prelude.Maybe Prelude.Text,
    -- | The recipe associated with this job.
    DescribeProjectResponse -> Maybe Text
recipeName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the project.
    DescribeProjectResponse -> Maybe Text
resourceArn :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the Identity and Access Management (IAM) role to be assumed
    -- when DataBrew runs the job.
    DescribeProjectResponse -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    DescribeProjectResponse -> Maybe Sample
sample :: Prelude.Maybe Sample,
    -- | Describes the current state of the session:
    --
    -- -   @PROVISIONING@ - allocating resources for the session.
    --
    -- -   @INITIALIZING@ - getting the session ready for first use.
    --
    -- -   @ASSIGNED@ - the session is ready for use.
    DescribeProjectResponse -> Maybe SessionStatus
sessionStatus :: Prelude.Maybe SessionStatus,
    -- | Metadata tags associated with this project.
    DescribeProjectResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    DescribeProjectResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the project.
    DescribeProjectResponse -> Text
name :: Prelude.Text
  }
  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:
--
-- 'createDate', 'describeProjectResponse_createDate' - The date and time that the project was created.
--
-- 'createdBy', 'describeProjectResponse_createdBy' - The identifier (user name) of the user who created the project.
--
-- 'datasetName', 'describeProjectResponse_datasetName' - The dataset associated with the project.
--
-- 'lastModifiedBy', 'describeProjectResponse_lastModifiedBy' - The identifier (user name) of the user who last modified the project.
--
-- 'lastModifiedDate', 'describeProjectResponse_lastModifiedDate' - The date and time that the project was last modified.
--
-- 'openDate', 'describeProjectResponse_openDate' - The date and time when the project was opened.
--
-- 'openedBy', 'describeProjectResponse_openedBy' - The identifier (user name) of the user that opened the project for use.
--
-- 'recipeName', 'describeProjectResponse_recipeName' - The recipe associated with this job.
--
-- 'resourceArn', 'describeProjectResponse_resourceArn' - The Amazon Resource Name (ARN) of the project.
--
-- 'roleArn', 'describeProjectResponse_roleArn' - The ARN of the Identity and Access Management (IAM) role to be assumed
-- when DataBrew runs the job.
--
-- 'sample', 'describeProjectResponse_sample' - Undocumented member.
--
-- 'sessionStatus', 'describeProjectResponse_sessionStatus' - Describes the current state of the session:
--
-- -   @PROVISIONING@ - allocating resources for the session.
--
-- -   @INITIALIZING@ - getting the session ready for first use.
--
-- -   @ASSIGNED@ - the session is ready for use.
--
-- 'tags', 'describeProjectResponse_tags' - Metadata tags associated with this project.
--
-- 'httpStatus', 'describeProjectResponse_httpStatus' - The response's http status code.
--
-- 'name', 'describeProjectResponse_name' - The name of the project.
newDescribeProjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'name'
  Prelude.Text ->
  DescribeProjectResponse
newDescribeProjectResponse :: Int -> Text -> DescribeProjectResponse
newDescribeProjectResponse Int
pHttpStatus_ Text
pName_ =
  DescribeProjectResponse'
    { $sel:createDate:DescribeProjectResponse' :: Maybe POSIX
createDate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:createdBy:DescribeProjectResponse' :: Maybe Text
createdBy = forall a. Maybe a
Prelude.Nothing,
      $sel:datasetName:DescribeProjectResponse' :: Maybe Text
datasetName = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedBy:DescribeProjectResponse' :: Maybe Text
lastModifiedBy = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedDate:DescribeProjectResponse' :: Maybe POSIX
lastModifiedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:openDate:DescribeProjectResponse' :: Maybe POSIX
openDate = forall a. Maybe a
Prelude.Nothing,
      $sel:openedBy:DescribeProjectResponse' :: Maybe Text
openedBy = forall a. Maybe a
Prelude.Nothing,
      $sel:recipeName:DescribeProjectResponse' :: Maybe Text
recipeName = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArn:DescribeProjectResponse' :: Maybe Text
resourceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:DescribeProjectResponse' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:sample:DescribeProjectResponse' :: Maybe Sample
sample = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionStatus:DescribeProjectResponse' :: Maybe SessionStatus
sessionStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:DescribeProjectResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeProjectResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:name:DescribeProjectResponse' :: Text
name = Text
pName_
    }

-- | The date and time that the project was created.
describeProjectResponse_createDate :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe Prelude.UTCTime)
describeProjectResponse_createDate :: Lens' DescribeProjectResponse (Maybe UTCTime)
describeProjectResponse_createDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe POSIX
createDate :: Maybe POSIX
$sel:createDate:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe POSIX
createDate} -> Maybe POSIX
createDate) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe POSIX
a -> DescribeProjectResponse
s {$sel:createDate:DescribeProjectResponse' :: Maybe POSIX
createDate = 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 identifier (user name) of the user who created the project.
describeProjectResponse_createdBy :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe Prelude.Text)
describeProjectResponse_createdBy :: Lens' DescribeProjectResponse (Maybe Text)
describeProjectResponse_createdBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe Text
createdBy :: Maybe Text
$sel:createdBy:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
createdBy} -> Maybe Text
createdBy) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe Text
a -> DescribeProjectResponse
s {$sel:createdBy:DescribeProjectResponse' :: Maybe Text
createdBy = Maybe Text
a} :: DescribeProjectResponse)

-- | The dataset associated with the project.
describeProjectResponse_datasetName :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe Prelude.Text)
describeProjectResponse_datasetName :: Lens' DescribeProjectResponse (Maybe Text)
describeProjectResponse_datasetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe Text
datasetName :: Maybe Text
$sel:datasetName:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
datasetName} -> Maybe Text
datasetName) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe Text
a -> DescribeProjectResponse
s {$sel:datasetName:DescribeProjectResponse' :: Maybe Text
datasetName = Maybe Text
a} :: DescribeProjectResponse)

-- | The identifier (user name) of the user who last modified the project.
describeProjectResponse_lastModifiedBy :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe Prelude.Text)
describeProjectResponse_lastModifiedBy :: Lens' DescribeProjectResponse (Maybe Text)
describeProjectResponse_lastModifiedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe Text
lastModifiedBy :: Maybe Text
$sel:lastModifiedBy:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
lastModifiedBy} -> Maybe Text
lastModifiedBy) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe Text
a -> DescribeProjectResponse
s {$sel:lastModifiedBy:DescribeProjectResponse' :: Maybe Text
lastModifiedBy = Maybe Text
a} :: DescribeProjectResponse)

-- | The date and time that the project was last modified.
describeProjectResponse_lastModifiedDate :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe Prelude.UTCTime)
describeProjectResponse_lastModifiedDate :: Lens' DescribeProjectResponse (Maybe UTCTime)
describeProjectResponse_lastModifiedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe POSIX
lastModifiedDate :: Maybe POSIX
$sel:lastModifiedDate:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe POSIX
lastModifiedDate} -> Maybe POSIX
lastModifiedDate) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe POSIX
a -> DescribeProjectResponse
s {$sel:lastModifiedDate:DescribeProjectResponse' :: Maybe POSIX
lastModifiedDate = 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 date and time when the project was opened.
describeProjectResponse_openDate :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe Prelude.UTCTime)
describeProjectResponse_openDate :: Lens' DescribeProjectResponse (Maybe UTCTime)
describeProjectResponse_openDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe POSIX
openDate :: Maybe POSIX
$sel:openDate:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe POSIX
openDate} -> Maybe POSIX
openDate) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe POSIX
a -> DescribeProjectResponse
s {$sel:openDate:DescribeProjectResponse' :: Maybe POSIX
openDate = 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 identifier (user name) of the user that opened the project for use.
describeProjectResponse_openedBy :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe Prelude.Text)
describeProjectResponse_openedBy :: Lens' DescribeProjectResponse (Maybe Text)
describeProjectResponse_openedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe Text
openedBy :: Maybe Text
$sel:openedBy:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
openedBy} -> Maybe Text
openedBy) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe Text
a -> DescribeProjectResponse
s {$sel:openedBy:DescribeProjectResponse' :: Maybe Text
openedBy = Maybe Text
a} :: DescribeProjectResponse)

-- | The recipe associated with this job.
describeProjectResponse_recipeName :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe Prelude.Text)
describeProjectResponse_recipeName :: Lens' DescribeProjectResponse (Maybe Text)
describeProjectResponse_recipeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe Text
recipeName :: Maybe Text
$sel:recipeName:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
recipeName} -> Maybe Text
recipeName) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe Text
a -> DescribeProjectResponse
s {$sel:recipeName:DescribeProjectResponse' :: Maybe Text
recipeName = Maybe Text
a} :: DescribeProjectResponse)

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

-- | The ARN of the Identity and Access Management (IAM) role to be assumed
-- when DataBrew runs the job.
describeProjectResponse_roleArn :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe Prelude.Text)
describeProjectResponse_roleArn :: Lens' DescribeProjectResponse (Maybe Text)
describeProjectResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe Text
a -> DescribeProjectResponse
s {$sel:roleArn:DescribeProjectResponse' :: Maybe Text
roleArn = Maybe Text
a} :: DescribeProjectResponse)

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

-- | Describes the current state of the session:
--
-- -   @PROVISIONING@ - allocating resources for the session.
--
-- -   @INITIALIZING@ - getting the session ready for first use.
--
-- -   @ASSIGNED@ - the session is ready for use.
describeProjectResponse_sessionStatus :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe SessionStatus)
describeProjectResponse_sessionStatus :: Lens' DescribeProjectResponse (Maybe SessionStatus)
describeProjectResponse_sessionStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe SessionStatus
sessionStatus :: Maybe SessionStatus
$sel:sessionStatus:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe SessionStatus
sessionStatus} -> Maybe SessionStatus
sessionStatus) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe SessionStatus
a -> DescribeProjectResponse
s {$sel:sessionStatus:DescribeProjectResponse' :: Maybe SessionStatus
sessionStatus = Maybe SessionStatus
a} :: DescribeProjectResponse)

-- | Metadata tags associated with this project.
describeProjectResponse_tags :: Lens.Lens' DescribeProjectResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
describeProjectResponse_tags :: Lens' DescribeProjectResponse (Maybe (HashMap Text Text))
describeProjectResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Maybe (HashMap Text Text)
a -> DescribeProjectResponse
s {$sel:tags:DescribeProjectResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | 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 name of the project.
describeProjectResponse_name :: Lens.Lens' DescribeProjectResponse Prelude.Text
describeProjectResponse_name :: Lens' DescribeProjectResponse Text
describeProjectResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectResponse' {Text
name :: Text
$sel:name:DescribeProjectResponse' :: DescribeProjectResponse -> Text
name} -> Text
name) (\s :: DescribeProjectResponse
s@DescribeProjectResponse' {} Text
a -> DescribeProjectResponse
s {$sel:name:DescribeProjectResponse' :: Text
name = Text
a} :: DescribeProjectResponse)

instance Prelude.NFData DescribeProjectResponse where
  rnf :: DescribeProjectResponse -> ()
rnf DescribeProjectResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe Sample
Maybe SessionStatus
Text
name :: Text
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
sessionStatus :: Maybe SessionStatus
sample :: Maybe Sample
roleArn :: Maybe Text
resourceArn :: Maybe Text
recipeName :: Maybe Text
openedBy :: Maybe Text
openDate :: Maybe POSIX
lastModifiedDate :: Maybe POSIX
lastModifiedBy :: Maybe Text
datasetName :: Maybe Text
createdBy :: Maybe Text
createDate :: Maybe POSIX
$sel:name:DescribeProjectResponse' :: DescribeProjectResponse -> Text
$sel:httpStatus:DescribeProjectResponse' :: DescribeProjectResponse -> Int
$sel:tags:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe (HashMap Text Text)
$sel:sessionStatus:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe SessionStatus
$sel:sample:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Sample
$sel:roleArn:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
$sel:resourceArn:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
$sel:recipeName:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
$sel:openedBy:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
$sel:openDate:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe POSIX
$sel:lastModifiedDate:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe POSIX
$sel:lastModifiedBy:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
$sel:datasetName:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
$sel:createdBy:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe Text
$sel:createDate:DescribeProjectResponse' :: DescribeProjectResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
createdBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
datasetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lastModifiedBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
openDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
openedBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
recipeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Sample
sample
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SessionStatus
sessionStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      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
name