{-# 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.Chime.ListMeetingTags
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the tags applied to an Amazon Chime SDK meeting resource.
module Amazonka.Chime.ListMeetingTags
  ( -- * Creating a Request
    ListMeetingTags (..),
    newListMeetingTags,

    -- * Request Lenses
    listMeetingTags_meetingId,

    -- * Destructuring the Response
    ListMeetingTagsResponse (..),
    newListMeetingTagsResponse,

    -- * Response Lenses
    listMeetingTagsResponse_tags,
    listMeetingTagsResponse_httpStatus,
  )
where

import Amazonka.Chime.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:/ 'newListMeetingTags' smart constructor.
data ListMeetingTags = ListMeetingTags'
  { -- | The Amazon Chime SDK meeting ID.
    ListMeetingTags -> Text
meetingId :: Prelude.Text
  }
  deriving (ListMeetingTags -> ListMeetingTags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMeetingTags -> ListMeetingTags -> Bool
$c/= :: ListMeetingTags -> ListMeetingTags -> Bool
== :: ListMeetingTags -> ListMeetingTags -> Bool
$c== :: ListMeetingTags -> ListMeetingTags -> Bool
Prelude.Eq, ReadPrec [ListMeetingTags]
ReadPrec ListMeetingTags
Int -> ReadS ListMeetingTags
ReadS [ListMeetingTags]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMeetingTags]
$creadListPrec :: ReadPrec [ListMeetingTags]
readPrec :: ReadPrec ListMeetingTags
$creadPrec :: ReadPrec ListMeetingTags
readList :: ReadS [ListMeetingTags]
$creadList :: ReadS [ListMeetingTags]
readsPrec :: Int -> ReadS ListMeetingTags
$creadsPrec :: Int -> ReadS ListMeetingTags
Prelude.Read, Int -> ListMeetingTags -> ShowS
[ListMeetingTags] -> ShowS
ListMeetingTags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMeetingTags] -> ShowS
$cshowList :: [ListMeetingTags] -> ShowS
show :: ListMeetingTags -> String
$cshow :: ListMeetingTags -> String
showsPrec :: Int -> ListMeetingTags -> ShowS
$cshowsPrec :: Int -> ListMeetingTags -> ShowS
Prelude.Show, forall x. Rep ListMeetingTags x -> ListMeetingTags
forall x. ListMeetingTags -> Rep ListMeetingTags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListMeetingTags x -> ListMeetingTags
$cfrom :: forall x. ListMeetingTags -> Rep ListMeetingTags x
Prelude.Generic)

-- |
-- Create a value of 'ListMeetingTags' 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:
--
-- 'meetingId', 'listMeetingTags_meetingId' - The Amazon Chime SDK meeting ID.
newListMeetingTags ::
  -- | 'meetingId'
  Prelude.Text ->
  ListMeetingTags
newListMeetingTags :: Text -> ListMeetingTags
newListMeetingTags Text
pMeetingId_ =
  ListMeetingTags' {$sel:meetingId:ListMeetingTags' :: Text
meetingId = Text
pMeetingId_}

-- | The Amazon Chime SDK meeting ID.
listMeetingTags_meetingId :: Lens.Lens' ListMeetingTags Prelude.Text
listMeetingTags_meetingId :: Lens' ListMeetingTags Text
listMeetingTags_meetingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMeetingTags' {Text
meetingId :: Text
$sel:meetingId:ListMeetingTags' :: ListMeetingTags -> Text
meetingId} -> Text
meetingId) (\s :: ListMeetingTags
s@ListMeetingTags' {} Text
a -> ListMeetingTags
s {$sel:meetingId:ListMeetingTags' :: Text
meetingId = Text
a} :: ListMeetingTags)

instance Core.AWSRequest ListMeetingTags where
  type
    AWSResponse ListMeetingTags =
      ListMeetingTagsResponse
  request :: (Service -> Service) -> ListMeetingTags -> Request ListMeetingTags
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 ListMeetingTags
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListMeetingTags)))
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 (NonEmpty Tag) -> Int -> ListMeetingTagsResponse
ListMeetingTagsResponse'
            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
"Tags")
            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 ListMeetingTags where
  hashWithSalt :: Int -> ListMeetingTags -> Int
hashWithSalt Int
_salt ListMeetingTags' {Text
meetingId :: Text
$sel:meetingId:ListMeetingTags' :: ListMeetingTags -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
meetingId

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

instance Data.ToHeaders ListMeetingTags where
  toHeaders :: ListMeetingTags -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

-- | /See:/ 'newListMeetingTagsResponse' smart constructor.
data ListMeetingTagsResponse = ListMeetingTagsResponse'
  { -- | A list of tag key-value pairs.
    ListMeetingTagsResponse -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The response's http status code.
    ListMeetingTagsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListMeetingTagsResponse -> ListMeetingTagsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMeetingTagsResponse -> ListMeetingTagsResponse -> Bool
$c/= :: ListMeetingTagsResponse -> ListMeetingTagsResponse -> Bool
== :: ListMeetingTagsResponse -> ListMeetingTagsResponse -> Bool
$c== :: ListMeetingTagsResponse -> ListMeetingTagsResponse -> Bool
Prelude.Eq, Int -> ListMeetingTagsResponse -> ShowS
[ListMeetingTagsResponse] -> ShowS
ListMeetingTagsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMeetingTagsResponse] -> ShowS
$cshowList :: [ListMeetingTagsResponse] -> ShowS
show :: ListMeetingTagsResponse -> String
$cshow :: ListMeetingTagsResponse -> String
showsPrec :: Int -> ListMeetingTagsResponse -> ShowS
$cshowsPrec :: Int -> ListMeetingTagsResponse -> ShowS
Prelude.Show, forall x. Rep ListMeetingTagsResponse x -> ListMeetingTagsResponse
forall x. ListMeetingTagsResponse -> Rep ListMeetingTagsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListMeetingTagsResponse x -> ListMeetingTagsResponse
$cfrom :: forall x. ListMeetingTagsResponse -> Rep ListMeetingTagsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListMeetingTagsResponse' 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:
--
-- 'tags', 'listMeetingTagsResponse_tags' - A list of tag key-value pairs.
--
-- 'httpStatus', 'listMeetingTagsResponse_httpStatus' - The response's http status code.
newListMeetingTagsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListMeetingTagsResponse
newListMeetingTagsResponse :: Int -> ListMeetingTagsResponse
newListMeetingTagsResponse Int
pHttpStatus_ =
  ListMeetingTagsResponse'
    { $sel:tags:ListMeetingTagsResponse' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListMeetingTagsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of tag key-value pairs.
listMeetingTagsResponse_tags :: Lens.Lens' ListMeetingTagsResponse (Prelude.Maybe (Prelude.NonEmpty Tag))
listMeetingTagsResponse_tags :: Lens' ListMeetingTagsResponse (Maybe (NonEmpty Tag))
listMeetingTagsResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMeetingTagsResponse' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:ListMeetingTagsResponse' :: ListMeetingTagsResponse -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: ListMeetingTagsResponse
s@ListMeetingTagsResponse' {} Maybe (NonEmpty Tag)
a -> ListMeetingTagsResponse
s {$sel:tags:ListMeetingTagsResponse' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: ListMeetingTagsResponse) 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.
listMeetingTagsResponse_httpStatus :: Lens.Lens' ListMeetingTagsResponse Prelude.Int
listMeetingTagsResponse_httpStatus :: Lens' ListMeetingTagsResponse Int
listMeetingTagsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMeetingTagsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListMeetingTagsResponse' :: ListMeetingTagsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListMeetingTagsResponse
s@ListMeetingTagsResponse' {} Int
a -> ListMeetingTagsResponse
s {$sel:httpStatus:ListMeetingTagsResponse' :: Int
httpStatus = Int
a} :: ListMeetingTagsResponse)

instance Prelude.NFData ListMeetingTagsResponse where
  rnf :: ListMeetingTagsResponse -> ()
rnf ListMeetingTagsResponse' {Int
Maybe (NonEmpty Tag)
httpStatus :: Int
tags :: Maybe (NonEmpty Tag)
$sel:httpStatus:ListMeetingTagsResponse' :: ListMeetingTagsResponse -> Int
$sel:tags:ListMeetingTagsResponse' :: ListMeetingTagsResponse -> Maybe (NonEmpty Tag)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus