{-# 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.Pinpoint.ListTemplates
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about all the message templates that are
-- associated with your Amazon Pinpoint account.
module Amazonka.Pinpoint.ListTemplates
  ( -- * Creating a Request
    ListTemplates (..),
    newListTemplates,

    -- * Request Lenses
    listTemplates_nextToken,
    listTemplates_pageSize,
    listTemplates_prefix,
    listTemplates_templateType,

    -- * Destructuring the Response
    ListTemplatesResponse (..),
    newListTemplatesResponse,

    -- * Response Lenses
    listTemplatesResponse_httpStatus,
    listTemplatesResponse_templatesResponse,
  )
where

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

-- | /See:/ 'newListTemplates' smart constructor.
data ListTemplates = ListTemplates'
  { -- | The string that specifies which page of results to return in a paginated
    -- response. This parameter is not supported for application, campaign, and
    -- journey metrics.
    ListTemplates -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of items to include in each page of a paginated
    -- response. This parameter is not supported for application, campaign, and
    -- journey metrics.
    ListTemplates -> Maybe Text
pageSize :: Prelude.Maybe Prelude.Text,
    -- | The substring to match in the names of the message templates to include
    -- in the results. If you specify this value, Amazon Pinpoint returns only
    -- those templates whose names begin with the value that you specify.
    ListTemplates -> Maybe Text
prefix :: Prelude.Maybe Prelude.Text,
    -- | The type of message template to include in the results. Valid values
    -- are: EMAIL, PUSH, SMS, and VOICE. To include all types of templates in
    -- the results, don\'t include this parameter in your request.
    ListTemplates -> Maybe Text
templateType :: Prelude.Maybe Prelude.Text
  }
  deriving (ListTemplates -> ListTemplates -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTemplates -> ListTemplates -> Bool
$c/= :: ListTemplates -> ListTemplates -> Bool
== :: ListTemplates -> ListTemplates -> Bool
$c== :: ListTemplates -> ListTemplates -> Bool
Prelude.Eq, ReadPrec [ListTemplates]
ReadPrec ListTemplates
Int -> ReadS ListTemplates
ReadS [ListTemplates]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTemplates]
$creadListPrec :: ReadPrec [ListTemplates]
readPrec :: ReadPrec ListTemplates
$creadPrec :: ReadPrec ListTemplates
readList :: ReadS [ListTemplates]
$creadList :: ReadS [ListTemplates]
readsPrec :: Int -> ReadS ListTemplates
$creadsPrec :: Int -> ReadS ListTemplates
Prelude.Read, Int -> ListTemplates -> ShowS
[ListTemplates] -> ShowS
ListTemplates -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTemplates] -> ShowS
$cshowList :: [ListTemplates] -> ShowS
show :: ListTemplates -> String
$cshow :: ListTemplates -> String
showsPrec :: Int -> ListTemplates -> ShowS
$cshowsPrec :: Int -> ListTemplates -> ShowS
Prelude.Show, forall x. Rep ListTemplates x -> ListTemplates
forall x. ListTemplates -> Rep ListTemplates x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTemplates x -> ListTemplates
$cfrom :: forall x. ListTemplates -> Rep ListTemplates x
Prelude.Generic)

-- |
-- Create a value of 'ListTemplates' 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', 'listTemplates_nextToken' - The string that specifies which page of results to return in a paginated
-- response. This parameter is not supported for application, campaign, and
-- journey metrics.
--
-- 'pageSize', 'listTemplates_pageSize' - The maximum number of items to include in each page of a paginated
-- response. This parameter is not supported for application, campaign, and
-- journey metrics.
--
-- 'prefix', 'listTemplates_prefix' - The substring to match in the names of the message templates to include
-- in the results. If you specify this value, Amazon Pinpoint returns only
-- those templates whose names begin with the value that you specify.
--
-- 'templateType', 'listTemplates_templateType' - The type of message template to include in the results. Valid values
-- are: EMAIL, PUSH, SMS, and VOICE. To include all types of templates in
-- the results, don\'t include this parameter in your request.
newListTemplates ::
  ListTemplates
newListTemplates :: ListTemplates
newListTemplates =
  ListTemplates'
    { $sel:nextToken:ListTemplates' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:pageSize:ListTemplates' :: Maybe Text
pageSize = forall a. Maybe a
Prelude.Nothing,
      $sel:prefix:ListTemplates' :: Maybe Text
prefix = forall a. Maybe a
Prelude.Nothing,
      $sel:templateType:ListTemplates' :: Maybe Text
templateType = forall a. Maybe a
Prelude.Nothing
    }

-- | The string that specifies which page of results to return in a paginated
-- response. This parameter is not supported for application, campaign, and
-- journey metrics.
listTemplates_nextToken :: Lens.Lens' ListTemplates (Prelude.Maybe Prelude.Text)
listTemplates_nextToken :: Lens' ListTemplates (Maybe Text)
listTemplates_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplates' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTemplates' :: ListTemplates -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTemplates
s@ListTemplates' {} Maybe Text
a -> ListTemplates
s {$sel:nextToken:ListTemplates' :: Maybe Text
nextToken = Maybe Text
a} :: ListTemplates)

-- | The maximum number of items to include in each page of a paginated
-- response. This parameter is not supported for application, campaign, and
-- journey metrics.
listTemplates_pageSize :: Lens.Lens' ListTemplates (Prelude.Maybe Prelude.Text)
listTemplates_pageSize :: Lens' ListTemplates (Maybe Text)
listTemplates_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplates' {Maybe Text
pageSize :: Maybe Text
$sel:pageSize:ListTemplates' :: ListTemplates -> Maybe Text
pageSize} -> Maybe Text
pageSize) (\s :: ListTemplates
s@ListTemplates' {} Maybe Text
a -> ListTemplates
s {$sel:pageSize:ListTemplates' :: Maybe Text
pageSize = Maybe Text
a} :: ListTemplates)

-- | The substring to match in the names of the message templates to include
-- in the results. If you specify this value, Amazon Pinpoint returns only
-- those templates whose names begin with the value that you specify.
listTemplates_prefix :: Lens.Lens' ListTemplates (Prelude.Maybe Prelude.Text)
listTemplates_prefix :: Lens' ListTemplates (Maybe Text)
listTemplates_prefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplates' {Maybe Text
prefix :: Maybe Text
$sel:prefix:ListTemplates' :: ListTemplates -> Maybe Text
prefix} -> Maybe Text
prefix) (\s :: ListTemplates
s@ListTemplates' {} Maybe Text
a -> ListTemplates
s {$sel:prefix:ListTemplates' :: Maybe Text
prefix = Maybe Text
a} :: ListTemplates)

-- | The type of message template to include in the results. Valid values
-- are: EMAIL, PUSH, SMS, and VOICE. To include all types of templates in
-- the results, don\'t include this parameter in your request.
listTemplates_templateType :: Lens.Lens' ListTemplates (Prelude.Maybe Prelude.Text)
listTemplates_templateType :: Lens' ListTemplates (Maybe Text)
listTemplates_templateType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplates' {Maybe Text
templateType :: Maybe Text
$sel:templateType:ListTemplates' :: ListTemplates -> Maybe Text
templateType} -> Maybe Text
templateType) (\s :: ListTemplates
s@ListTemplates' {} Maybe Text
a -> ListTemplates
s {$sel:templateType:ListTemplates' :: Maybe Text
templateType = Maybe Text
a} :: ListTemplates)

instance Core.AWSRequest ListTemplates where
  type
    AWSResponse ListTemplates =
      ListTemplatesResponse
  request :: (Service -> Service) -> ListTemplates -> Request ListTemplates
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 ListTemplates
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListTemplates)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> TemplatesResponse -> ListTemplatesResponse
ListTemplatesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)
      )

instance Prelude.Hashable ListTemplates where
  hashWithSalt :: Int -> ListTemplates -> Int
hashWithSalt Int
_salt ListTemplates' {Maybe Text
templateType :: Maybe Text
prefix :: Maybe Text
pageSize :: Maybe Text
nextToken :: Maybe Text
$sel:templateType:ListTemplates' :: ListTemplates -> Maybe Text
$sel:prefix:ListTemplates' :: ListTemplates -> Maybe Text
$sel:pageSize:ListTemplates' :: ListTemplates -> Maybe Text
$sel:nextToken:ListTemplates' :: ListTemplates -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pageSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
prefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateType

instance Prelude.NFData ListTemplates where
  rnf :: ListTemplates -> ()
rnf ListTemplates' {Maybe Text
templateType :: Maybe Text
prefix :: Maybe Text
pageSize :: Maybe Text
nextToken :: Maybe Text
$sel:templateType:ListTemplates' :: ListTemplates -> Maybe Text
$sel:prefix:ListTemplates' :: ListTemplates -> Maybe Text
$sel:pageSize:ListTemplates' :: ListTemplates -> Maybe Text
$sel:nextToken:ListTemplates' :: ListTemplates -> 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 Text
pageSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
prefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateType

instance Data.ToHeaders ListTemplates where
  toHeaders :: ListTemplates -> 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 ListTemplates where
  toPath :: ListTemplates -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v1/templates"

instance Data.ToQuery ListTemplates where
  toQuery :: ListTemplates -> QueryString
toQuery ListTemplates' {Maybe Text
templateType :: Maybe Text
prefix :: Maybe Text
pageSize :: Maybe Text
nextToken :: Maybe Text
$sel:templateType:ListTemplates' :: ListTemplates -> Maybe Text
$sel:prefix:ListTemplates' :: ListTemplates -> Maybe Text
$sel:pageSize:ListTemplates' :: ListTemplates -> Maybe Text
$sel:nextToken:ListTemplates' :: ListTemplates -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"next-token" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"page-size" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
pageSize,
        ByteString
"prefix" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
prefix,
        ByteString
"template-type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
templateType
      ]

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

-- |
-- Create a value of 'ListTemplatesResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'listTemplatesResponse_httpStatus' - The response's http status code.
--
-- 'templatesResponse', 'listTemplatesResponse_templatesResponse' - Undocumented member.
newListTemplatesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'templatesResponse'
  TemplatesResponse ->
  ListTemplatesResponse
newListTemplatesResponse :: Int -> TemplatesResponse -> ListTemplatesResponse
newListTemplatesResponse
  Int
pHttpStatus_
  TemplatesResponse
pTemplatesResponse_ =
    ListTemplatesResponse'
      { $sel:httpStatus:ListTemplatesResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:templatesResponse:ListTemplatesResponse' :: TemplatesResponse
templatesResponse = TemplatesResponse
pTemplatesResponse_
      }

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

-- | Undocumented member.
listTemplatesResponse_templatesResponse :: Lens.Lens' ListTemplatesResponse TemplatesResponse
listTemplatesResponse_templatesResponse :: Lens' ListTemplatesResponse TemplatesResponse
listTemplatesResponse_templatesResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplatesResponse' {TemplatesResponse
templatesResponse :: TemplatesResponse
$sel:templatesResponse:ListTemplatesResponse' :: ListTemplatesResponse -> TemplatesResponse
templatesResponse} -> TemplatesResponse
templatesResponse) (\s :: ListTemplatesResponse
s@ListTemplatesResponse' {} TemplatesResponse
a -> ListTemplatesResponse
s {$sel:templatesResponse:ListTemplatesResponse' :: TemplatesResponse
templatesResponse = TemplatesResponse
a} :: ListTemplatesResponse)

instance Prelude.NFData ListTemplatesResponse where
  rnf :: ListTemplatesResponse -> ()
rnf ListTemplatesResponse' {Int
TemplatesResponse
templatesResponse :: TemplatesResponse
httpStatus :: Int
$sel:templatesResponse:ListTemplatesResponse' :: ListTemplatesResponse -> TemplatesResponse
$sel:httpStatus:ListTemplatesResponse' :: ListTemplatesResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TemplatesResponse
templatesResponse