{-# 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.SNS.CreatePlatformApplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a platform application object for one of the supported push
-- notification services, such as APNS and GCM (Firebase Cloud Messaging),
-- to which devices and mobile apps may register. You must specify
-- @PlatformPrincipal@ and @PlatformCredential@ attributes when using the
-- @CreatePlatformApplication@ action.
--
-- @PlatformPrincipal@ and @PlatformCredential@ are received from the
-- notification service.
--
-- -   For @ADM@, @PlatformPrincipal@ is @client id@ and
--     @PlatformCredential@ is @client secret@.
--
-- -   For @Baidu@, @PlatformPrincipal@ is @API key@ and
--     @PlatformCredential@ is @secret key@.
--
-- -   For @APNS@ and @APNS_SANDBOX@ using certificate credentials,
--     @PlatformPrincipal@ is @SSL certificate@ and @PlatformCredential@ is
--     @private key@.
--
-- -   For @APNS@ and @APNS_SANDBOX@ using token credentials,
--     @PlatformPrincipal@ is @signing key ID@ and @PlatformCredential@ is
--     @signing key@.
--
-- -   For @GCM@ (Firebase Cloud Messaging), there is no
--     @PlatformPrincipal@ and the @PlatformCredential@ is @API key@.
--
-- -   For @MPNS@, @PlatformPrincipal@ is @TLS certificate@ and
--     @PlatformCredential@ is @private key@.
--
-- -   For @WNS@, @PlatformPrincipal@ is @Package Security Identifier@ and
--     @PlatformCredential@ is @secret key@.
--
-- You can use the returned @PlatformApplicationArn@ as an attribute for
-- the @CreatePlatformEndpoint@ action.
module Amazonka.SNS.CreatePlatformApplication
  ( -- * Creating a Request
    CreatePlatformApplication (..),
    newCreatePlatformApplication,

    -- * Request Lenses
    createPlatformApplication_name,
    createPlatformApplication_platform,
    createPlatformApplication_attributes,

    -- * Destructuring the Response
    CreatePlatformApplicationResponse (..),
    newCreatePlatformApplicationResponse,

    -- * Response Lenses
    createPlatformApplicationResponse_platformApplicationArn,
    createPlatformApplicationResponse_httpStatus,
  )
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.SNS.Types

-- | Input for CreatePlatformApplication action.
--
-- /See:/ 'newCreatePlatformApplication' smart constructor.
data CreatePlatformApplication = CreatePlatformApplication'
  { -- | Application names must be made up of only uppercase and lowercase ASCII
    -- letters, numbers, underscores, hyphens, and periods, and must be between
    -- 1 and 256 characters long.
    CreatePlatformApplication -> Text
name :: Prelude.Text,
    -- | The following platforms are supported: ADM (Amazon Device Messaging),
    -- APNS (Apple Push Notification Service), APNS_SANDBOX, and GCM (Firebase
    -- Cloud Messaging).
    CreatePlatformApplication -> Text
platform :: Prelude.Text,
    -- | For a list of attributes, see
    -- <https://docs.aws.amazon.com/sns/latest/api/API_SetPlatformApplicationAttributes.html SetPlatformApplicationAttributes>.
    CreatePlatformApplication -> HashMap Text Text
attributes :: Prelude.HashMap Prelude.Text Prelude.Text
  }
  deriving (CreatePlatformApplication -> CreatePlatformApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePlatformApplication -> CreatePlatformApplication -> Bool
$c/= :: CreatePlatformApplication -> CreatePlatformApplication -> Bool
== :: CreatePlatformApplication -> CreatePlatformApplication -> Bool
$c== :: CreatePlatformApplication -> CreatePlatformApplication -> Bool
Prelude.Eq, ReadPrec [CreatePlatformApplication]
ReadPrec CreatePlatformApplication
Int -> ReadS CreatePlatformApplication
ReadS [CreatePlatformApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePlatformApplication]
$creadListPrec :: ReadPrec [CreatePlatformApplication]
readPrec :: ReadPrec CreatePlatformApplication
$creadPrec :: ReadPrec CreatePlatformApplication
readList :: ReadS [CreatePlatformApplication]
$creadList :: ReadS [CreatePlatformApplication]
readsPrec :: Int -> ReadS CreatePlatformApplication
$creadsPrec :: Int -> ReadS CreatePlatformApplication
Prelude.Read, Int -> CreatePlatformApplication -> ShowS
[CreatePlatformApplication] -> ShowS
CreatePlatformApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePlatformApplication] -> ShowS
$cshowList :: [CreatePlatformApplication] -> ShowS
show :: CreatePlatformApplication -> String
$cshow :: CreatePlatformApplication -> String
showsPrec :: Int -> CreatePlatformApplication -> ShowS
$cshowsPrec :: Int -> CreatePlatformApplication -> ShowS
Prelude.Show, forall x.
Rep CreatePlatformApplication x -> CreatePlatformApplication
forall x.
CreatePlatformApplication -> Rep CreatePlatformApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreatePlatformApplication x -> CreatePlatformApplication
$cfrom :: forall x.
CreatePlatformApplication -> Rep CreatePlatformApplication x
Prelude.Generic)

-- |
-- Create a value of 'CreatePlatformApplication' 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', 'createPlatformApplication_name' - Application names must be made up of only uppercase and lowercase ASCII
-- letters, numbers, underscores, hyphens, and periods, and must be between
-- 1 and 256 characters long.
--
-- 'platform', 'createPlatformApplication_platform' - The following platforms are supported: ADM (Amazon Device Messaging),
-- APNS (Apple Push Notification Service), APNS_SANDBOX, and GCM (Firebase
-- Cloud Messaging).
--
-- 'attributes', 'createPlatformApplication_attributes' - For a list of attributes, see
-- <https://docs.aws.amazon.com/sns/latest/api/API_SetPlatformApplicationAttributes.html SetPlatformApplicationAttributes>.
newCreatePlatformApplication ::
  -- | 'name'
  Prelude.Text ->
  -- | 'platform'
  Prelude.Text ->
  CreatePlatformApplication
newCreatePlatformApplication :: Text -> Text -> CreatePlatformApplication
newCreatePlatformApplication Text
pName_ Text
pPlatform_ =
  CreatePlatformApplication'
    { $sel:name:CreatePlatformApplication' :: Text
name = Text
pName_,
      $sel:platform:CreatePlatformApplication' :: Text
platform = Text
pPlatform_,
      $sel:attributes:CreatePlatformApplication' :: HashMap Text Text
attributes = forall a. Monoid a => a
Prelude.mempty
    }

-- | Application names must be made up of only uppercase and lowercase ASCII
-- letters, numbers, underscores, hyphens, and periods, and must be between
-- 1 and 256 characters long.
createPlatformApplication_name :: Lens.Lens' CreatePlatformApplication Prelude.Text
createPlatformApplication_name :: Lens' CreatePlatformApplication Text
createPlatformApplication_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformApplication' {Text
name :: Text
$sel:name:CreatePlatformApplication' :: CreatePlatformApplication -> Text
name} -> Text
name) (\s :: CreatePlatformApplication
s@CreatePlatformApplication' {} Text
a -> CreatePlatformApplication
s {$sel:name:CreatePlatformApplication' :: Text
name = Text
a} :: CreatePlatformApplication)

-- | The following platforms are supported: ADM (Amazon Device Messaging),
-- APNS (Apple Push Notification Service), APNS_SANDBOX, and GCM (Firebase
-- Cloud Messaging).
createPlatformApplication_platform :: Lens.Lens' CreatePlatformApplication Prelude.Text
createPlatformApplication_platform :: Lens' CreatePlatformApplication Text
createPlatformApplication_platform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformApplication' {Text
platform :: Text
$sel:platform:CreatePlatformApplication' :: CreatePlatformApplication -> Text
platform} -> Text
platform) (\s :: CreatePlatformApplication
s@CreatePlatformApplication' {} Text
a -> CreatePlatformApplication
s {$sel:platform:CreatePlatformApplication' :: Text
platform = Text
a} :: CreatePlatformApplication)

-- | For a list of attributes, see
-- <https://docs.aws.amazon.com/sns/latest/api/API_SetPlatformApplicationAttributes.html SetPlatformApplicationAttributes>.
createPlatformApplication_attributes :: Lens.Lens' CreatePlatformApplication (Prelude.HashMap Prelude.Text Prelude.Text)
createPlatformApplication_attributes :: Lens' CreatePlatformApplication (HashMap Text Text)
createPlatformApplication_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformApplication' {HashMap Text Text
attributes :: HashMap Text Text
$sel:attributes:CreatePlatformApplication' :: CreatePlatformApplication -> HashMap Text Text
attributes} -> HashMap Text Text
attributes) (\s :: CreatePlatformApplication
s@CreatePlatformApplication' {} HashMap Text Text
a -> CreatePlatformApplication
s {$sel:attributes:CreatePlatformApplication' :: HashMap Text Text
attributes = HashMap Text Text
a} :: CreatePlatformApplication) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreatePlatformApplication where
  type
    AWSResponse CreatePlatformApplication =
      CreatePlatformApplicationResponse
  request :: (Service -> Service)
-> CreatePlatformApplication -> Request CreatePlatformApplication
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreatePlatformApplication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreatePlatformApplication)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"CreatePlatformApplicationResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> CreatePlatformApplicationResponse
CreatePlatformApplicationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"PlatformApplicationArn")
            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 CreatePlatformApplication where
  hashWithSalt :: Int -> CreatePlatformApplication -> Int
hashWithSalt Int
_salt CreatePlatformApplication' {Text
HashMap Text Text
attributes :: HashMap Text Text
platform :: Text
name :: Text
$sel:attributes:CreatePlatformApplication' :: CreatePlatformApplication -> HashMap Text Text
$sel:platform:CreatePlatformApplication' :: CreatePlatformApplication -> Text
$sel:name:CreatePlatformApplication' :: CreatePlatformApplication -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
platform
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text Text
attributes

instance Prelude.NFData CreatePlatformApplication where
  rnf :: CreatePlatformApplication -> ()
rnf CreatePlatformApplication' {Text
HashMap Text Text
attributes :: HashMap Text Text
platform :: Text
name :: Text
$sel:attributes:CreatePlatformApplication' :: CreatePlatformApplication -> HashMap Text Text
$sel:platform:CreatePlatformApplication' :: CreatePlatformApplication -> Text
$sel:name:CreatePlatformApplication' :: CreatePlatformApplication -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
platform
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text Text
attributes

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

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

instance Data.ToQuery CreatePlatformApplication where
  toQuery :: CreatePlatformApplication -> QueryString
toQuery CreatePlatformApplication' {Text
HashMap Text Text
attributes :: HashMap Text Text
platform :: Text
name :: Text
$sel:attributes:CreatePlatformApplication' :: CreatePlatformApplication -> HashMap Text Text
$sel:platform:CreatePlatformApplication' :: CreatePlatformApplication -> Text
$sel:name:CreatePlatformApplication' :: CreatePlatformApplication -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreatePlatformApplication" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-03-31" :: Prelude.ByteString),
        ByteString
"Name" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
name,
        ByteString
"Platform" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
platform,
        ByteString
"Attributes"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall k v.
(ToQuery k, ToQuery v) =>
ByteString
-> ByteString -> ByteString -> HashMap k v -> QueryString
Data.toQueryMap ByteString
"entry" ByteString
"key" ByteString
"value" HashMap Text Text
attributes
      ]

-- | Response from CreatePlatformApplication action.
--
-- /See:/ 'newCreatePlatformApplicationResponse' smart constructor.
data CreatePlatformApplicationResponse = CreatePlatformApplicationResponse'
  { -- | PlatformApplicationArn is returned.
    CreatePlatformApplicationResponse -> Maybe Text
platformApplicationArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreatePlatformApplicationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreatePlatformApplicationResponse
-> CreatePlatformApplicationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePlatformApplicationResponse
-> CreatePlatformApplicationResponse -> Bool
$c/= :: CreatePlatformApplicationResponse
-> CreatePlatformApplicationResponse -> Bool
== :: CreatePlatformApplicationResponse
-> CreatePlatformApplicationResponse -> Bool
$c== :: CreatePlatformApplicationResponse
-> CreatePlatformApplicationResponse -> Bool
Prelude.Eq, ReadPrec [CreatePlatformApplicationResponse]
ReadPrec CreatePlatformApplicationResponse
Int -> ReadS CreatePlatformApplicationResponse
ReadS [CreatePlatformApplicationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePlatformApplicationResponse]
$creadListPrec :: ReadPrec [CreatePlatformApplicationResponse]
readPrec :: ReadPrec CreatePlatformApplicationResponse
$creadPrec :: ReadPrec CreatePlatformApplicationResponse
readList :: ReadS [CreatePlatformApplicationResponse]
$creadList :: ReadS [CreatePlatformApplicationResponse]
readsPrec :: Int -> ReadS CreatePlatformApplicationResponse
$creadsPrec :: Int -> ReadS CreatePlatformApplicationResponse
Prelude.Read, Int -> CreatePlatformApplicationResponse -> ShowS
[CreatePlatformApplicationResponse] -> ShowS
CreatePlatformApplicationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePlatformApplicationResponse] -> ShowS
$cshowList :: [CreatePlatformApplicationResponse] -> ShowS
show :: CreatePlatformApplicationResponse -> String
$cshow :: CreatePlatformApplicationResponse -> String
showsPrec :: Int -> CreatePlatformApplicationResponse -> ShowS
$cshowsPrec :: Int -> CreatePlatformApplicationResponse -> ShowS
Prelude.Show, forall x.
Rep CreatePlatformApplicationResponse x
-> CreatePlatformApplicationResponse
forall x.
CreatePlatformApplicationResponse
-> Rep CreatePlatformApplicationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreatePlatformApplicationResponse x
-> CreatePlatformApplicationResponse
$cfrom :: forall x.
CreatePlatformApplicationResponse
-> Rep CreatePlatformApplicationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreatePlatformApplicationResponse' 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:
--
-- 'platformApplicationArn', 'createPlatformApplicationResponse_platformApplicationArn' - PlatformApplicationArn is returned.
--
-- 'httpStatus', 'createPlatformApplicationResponse_httpStatus' - The response's http status code.
newCreatePlatformApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreatePlatformApplicationResponse
newCreatePlatformApplicationResponse :: Int -> CreatePlatformApplicationResponse
newCreatePlatformApplicationResponse Int
pHttpStatus_ =
  CreatePlatformApplicationResponse'
    { $sel:platformApplicationArn:CreatePlatformApplicationResponse' :: Maybe Text
platformApplicationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreatePlatformApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | PlatformApplicationArn is returned.
createPlatformApplicationResponse_platformApplicationArn :: Lens.Lens' CreatePlatformApplicationResponse (Prelude.Maybe Prelude.Text)
createPlatformApplicationResponse_platformApplicationArn :: Lens' CreatePlatformApplicationResponse (Maybe Text)
createPlatformApplicationResponse_platformApplicationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformApplicationResponse' {Maybe Text
platformApplicationArn :: Maybe Text
$sel:platformApplicationArn:CreatePlatformApplicationResponse' :: CreatePlatformApplicationResponse -> Maybe Text
platformApplicationArn} -> Maybe Text
platformApplicationArn) (\s :: CreatePlatformApplicationResponse
s@CreatePlatformApplicationResponse' {} Maybe Text
a -> CreatePlatformApplicationResponse
s {$sel:platformApplicationArn:CreatePlatformApplicationResponse' :: Maybe Text
platformApplicationArn = Maybe Text
a} :: CreatePlatformApplicationResponse)

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

instance
  Prelude.NFData
    CreatePlatformApplicationResponse
  where
  rnf :: CreatePlatformApplicationResponse -> ()
rnf CreatePlatformApplicationResponse' {Int
Maybe Text
httpStatus :: Int
platformApplicationArn :: Maybe Text
$sel:httpStatus:CreatePlatformApplicationResponse' :: CreatePlatformApplicationResponse -> Int
$sel:platformApplicationArn:CreatePlatformApplicationResponse' :: CreatePlatformApplicationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
platformApplicationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus