{-# 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.CodeStar.ListTagsForProject
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the tags for a project.
module Amazonka.CodeStar.ListTagsForProject
  ( -- * Creating a Request
    ListTagsForProject (..),
    newListTagsForProject,

    -- * Request Lenses
    listTagsForProject_maxResults,
    listTagsForProject_nextToken,
    listTagsForProject_id,

    -- * Destructuring the Response
    ListTagsForProjectResponse (..),
    newListTagsForProjectResponse,

    -- * Response Lenses
    listTagsForProjectResponse_nextToken,
    listTagsForProjectResponse_tags,
    listTagsForProjectResponse_httpStatus,
  )
where

import Amazonka.CodeStar.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:/ 'newListTagsForProject' smart constructor.
data ListTagsForProject = ListTagsForProject'
  { -- | Reserved for future use.
    ListTagsForProject -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Reserved for future use.
    ListTagsForProject -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the project to get tags for.
    ListTagsForProject -> Text
id :: Prelude.Text
  }
  deriving (ListTagsForProject -> ListTagsForProject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTagsForProject -> ListTagsForProject -> Bool
$c/= :: ListTagsForProject -> ListTagsForProject -> Bool
== :: ListTagsForProject -> ListTagsForProject -> Bool
$c== :: ListTagsForProject -> ListTagsForProject -> Bool
Prelude.Eq, ReadPrec [ListTagsForProject]
ReadPrec ListTagsForProject
Int -> ReadS ListTagsForProject
ReadS [ListTagsForProject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTagsForProject]
$creadListPrec :: ReadPrec [ListTagsForProject]
readPrec :: ReadPrec ListTagsForProject
$creadPrec :: ReadPrec ListTagsForProject
readList :: ReadS [ListTagsForProject]
$creadList :: ReadS [ListTagsForProject]
readsPrec :: Int -> ReadS ListTagsForProject
$creadsPrec :: Int -> ReadS ListTagsForProject
Prelude.Read, Int -> ListTagsForProject -> ShowS
[ListTagsForProject] -> ShowS
ListTagsForProject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTagsForProject] -> ShowS
$cshowList :: [ListTagsForProject] -> ShowS
show :: ListTagsForProject -> String
$cshow :: ListTagsForProject -> String
showsPrec :: Int -> ListTagsForProject -> ShowS
$cshowsPrec :: Int -> ListTagsForProject -> ShowS
Prelude.Show, forall x. Rep ListTagsForProject x -> ListTagsForProject
forall x. ListTagsForProject -> Rep ListTagsForProject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTagsForProject x -> ListTagsForProject
$cfrom :: forall x. ListTagsForProject -> Rep ListTagsForProject x
Prelude.Generic)

-- |
-- Create a value of 'ListTagsForProject' 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:
--
-- 'maxResults', 'listTagsForProject_maxResults' - Reserved for future use.
--
-- 'nextToken', 'listTagsForProject_nextToken' - Reserved for future use.
--
-- 'id', 'listTagsForProject_id' - The ID of the project to get tags for.
newListTagsForProject ::
  -- | 'id'
  Prelude.Text ->
  ListTagsForProject
newListTagsForProject :: Text -> ListTagsForProject
newListTagsForProject Text
pId_ =
  ListTagsForProject'
    { $sel:maxResults:ListTagsForProject' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListTagsForProject' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:id:ListTagsForProject' :: Text
id = Text
pId_
    }

-- | Reserved for future use.
listTagsForProject_maxResults :: Lens.Lens' ListTagsForProject (Prelude.Maybe Prelude.Natural)
listTagsForProject_maxResults :: Lens' ListTagsForProject (Maybe Natural)
listTagsForProject_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForProject' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListTagsForProject' :: ListTagsForProject -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListTagsForProject
s@ListTagsForProject' {} Maybe Natural
a -> ListTagsForProject
s {$sel:maxResults:ListTagsForProject' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListTagsForProject)

-- | Reserved for future use.
listTagsForProject_nextToken :: Lens.Lens' ListTagsForProject (Prelude.Maybe Prelude.Text)
listTagsForProject_nextToken :: Lens' ListTagsForProject (Maybe Text)
listTagsForProject_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForProject' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTagsForProject' :: ListTagsForProject -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTagsForProject
s@ListTagsForProject' {} Maybe Text
a -> ListTagsForProject
s {$sel:nextToken:ListTagsForProject' :: Maybe Text
nextToken = Maybe Text
a} :: ListTagsForProject)

-- | The ID of the project to get tags for.
listTagsForProject_id :: Lens.Lens' ListTagsForProject Prelude.Text
listTagsForProject_id :: Lens' ListTagsForProject Text
listTagsForProject_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForProject' {Text
id :: Text
$sel:id:ListTagsForProject' :: ListTagsForProject -> Text
id} -> Text
id) (\s :: ListTagsForProject
s@ListTagsForProject' {} Text
a -> ListTagsForProject
s {$sel:id:ListTagsForProject' :: Text
id = Text
a} :: ListTagsForProject)

instance Core.AWSRequest ListTagsForProject where
  type
    AWSResponse ListTagsForProject =
      ListTagsForProjectResponse
  request :: (Service -> Service)
-> ListTagsForProject -> Request ListTagsForProject
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 ListTagsForProject
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListTagsForProject)))
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 Text
-> Maybe (HashMap Text Text) -> Int -> ListTagsForProjectResponse
ListTagsForProjectResponse'
            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
"nextToken")
            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))
      )

instance Prelude.Hashable ListTagsForProject where
  hashWithSalt :: Int -> ListTagsForProject -> Int
hashWithSalt Int
_salt ListTagsForProject' {Maybe Natural
Maybe Text
Text
id :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:id:ListTagsForProject' :: ListTagsForProject -> Text
$sel:nextToken:ListTagsForProject' :: ListTagsForProject -> Maybe Text
$sel:maxResults:ListTagsForProject' :: ListTagsForProject -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData ListTagsForProject where
  rnf :: ListTagsForProject -> ()
rnf ListTagsForProject' {Maybe Natural
Maybe Text
Text
id :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:id:ListTagsForProject' :: ListTagsForProject -> Text
$sel:nextToken:ListTagsForProject' :: ListTagsForProject -> Maybe Text
$sel:maxResults:ListTagsForProject' :: ListTagsForProject -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders ListTagsForProject where
  toHeaders :: ListTagsForProject -> 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
"CodeStar_20170419.ListTagsForProject" ::
                          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 ListTagsForProject where
  toJSON :: ListTagsForProject -> Value
toJSON ListTagsForProject' {Maybe Natural
Maybe Text
Text
id :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:id:ListTagsForProject' :: ListTagsForProject -> Text
$sel:nextToken:ListTagsForProject' :: ListTagsForProject -> Maybe Text
$sel:maxResults:ListTagsForProject' :: ListTagsForProject -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"maxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxResults,
            (Key
"nextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
id)
          ]
      )

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

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

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

-- |
-- Create a value of 'ListTagsForProjectResponse' 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:
--
-- 'nextToken', 'listTagsForProjectResponse_nextToken' - Reserved for future use.
--
-- 'tags', 'listTagsForProjectResponse_tags' - The tags for the project.
--
-- 'httpStatus', 'listTagsForProjectResponse_httpStatus' - The response's http status code.
newListTagsForProjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListTagsForProjectResponse
newListTagsForProjectResponse :: Int -> ListTagsForProjectResponse
newListTagsForProjectResponse Int
pHttpStatus_ =
  ListTagsForProjectResponse'
    { $sel:nextToken:ListTagsForProjectResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ListTagsForProjectResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListTagsForProjectResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Reserved for future use.
listTagsForProjectResponse_nextToken :: Lens.Lens' ListTagsForProjectResponse (Prelude.Maybe Prelude.Text)
listTagsForProjectResponse_nextToken :: Lens' ListTagsForProjectResponse (Maybe Text)
listTagsForProjectResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForProjectResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTagsForProjectResponse' :: ListTagsForProjectResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTagsForProjectResponse
s@ListTagsForProjectResponse' {} Maybe Text
a -> ListTagsForProjectResponse
s {$sel:nextToken:ListTagsForProjectResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListTagsForProjectResponse)

-- | The tags for the project.
listTagsForProjectResponse_tags :: Lens.Lens' ListTagsForProjectResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
listTagsForProjectResponse_tags :: Lens' ListTagsForProjectResponse (Maybe (HashMap Text Text))
listTagsForProjectResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForProjectResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:ListTagsForProjectResponse' :: ListTagsForProjectResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: ListTagsForProjectResponse
s@ListTagsForProjectResponse' {} Maybe (HashMap Text Text)
a -> ListTagsForProjectResponse
s {$sel:tags:ListTagsForProjectResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: ListTagsForProjectResponse) 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.
listTagsForProjectResponse_httpStatus :: Lens.Lens' ListTagsForProjectResponse Prelude.Int
listTagsForProjectResponse_httpStatus :: Lens' ListTagsForProjectResponse Int
listTagsForProjectResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForProjectResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListTagsForProjectResponse' :: ListTagsForProjectResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListTagsForProjectResponse
s@ListTagsForProjectResponse' {} Int
a -> ListTagsForProjectResponse
s {$sel:httpStatus:ListTagsForProjectResponse' :: Int
httpStatus = Int
a} :: ListTagsForProjectResponse)

instance Prelude.NFData ListTagsForProjectResponse where
  rnf :: ListTagsForProjectResponse -> ()
rnf ListTagsForProjectResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
nextToken :: Maybe Text
$sel:httpStatus:ListTagsForProjectResponse' :: ListTagsForProjectResponse -> Int
$sel:tags:ListTagsForProjectResponse' :: ListTagsForProjectResponse -> Maybe (HashMap Text Text)
$sel:nextToken:ListTagsForProjectResponse' :: ListTagsForProjectResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      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