{-# 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.Lightsail.CreateContactMethod
-- 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 an email or SMS text message contact method.
--
-- A contact method is used to send you notifications about your Amazon
-- Lightsail resources. You can add one email address and one mobile phone
-- number contact method in each Amazon Web Services Region. However, SMS
-- text messaging is not supported in some Amazon Web Services Regions, and
-- SMS text messages cannot be sent to some countries\/regions. For more
-- information, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-notifications Notifications in Amazon Lightsail>.
module Amazonka.Lightsail.CreateContactMethod
  ( -- * Creating a Request
    CreateContactMethod (..),
    newCreateContactMethod,

    -- * Request Lenses
    createContactMethod_protocol,
    createContactMethod_contactEndpoint,

    -- * Destructuring the Response
    CreateContactMethodResponse (..),
    newCreateContactMethodResponse,

    -- * Response Lenses
    createContactMethodResponse_operations,
    createContactMethodResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateContactMethod' smart constructor.
data CreateContactMethod = CreateContactMethod'
  { -- | The protocol of the contact method, such as @Email@ or @SMS@ (text
    -- messaging).
    --
    -- The @SMS@ protocol is supported only in the following Amazon Web
    -- Services Regions.
    --
    -- -   US East (N. Virginia) (@us-east-1@)
    --
    -- -   US West (Oregon) (@us-west-2@)
    --
    -- -   Europe (Ireland) (@eu-west-1@)
    --
    -- -   Asia Pacific (Tokyo) (@ap-northeast-1@)
    --
    -- -   Asia Pacific (Singapore) (@ap-southeast-1@)
    --
    -- -   Asia Pacific (Sydney) (@ap-southeast-2@)
    --
    -- For a list of countries\/regions where SMS text messages can be sent,
    -- and the latest Amazon Web Services Regions where SMS text messaging is
    -- supported, see
    -- <https://docs.aws.amazon.com/sns/latest/dg/sns-supported-regions-countries.html Supported Regions and Countries>
    -- in the /Amazon SNS Developer Guide/.
    --
    -- For more information about notifications in Amazon Lightsail, see
    -- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-notifications Notifications in Amazon Lightsail>.
    CreateContactMethod -> ContactProtocol
protocol :: ContactProtocol,
    -- | The destination of the contact method, such as an email address or a
    -- mobile phone number.
    --
    -- Use the E.164 format when specifying a mobile phone number. E.164 is a
    -- standard for the phone number structure used for international
    -- telecommunication. Phone numbers that follow this format can have a
    -- maximum of 15 digits, and they are prefixed with the plus character (+)
    -- and the country code. For example, a U.S. phone number in E.164 format
    -- would be specified as +1XXX5550100. For more information, see
    -- <https://en.wikipedia.org/wiki/E.164 E.164> on /Wikipedia/.
    CreateContactMethod -> Text
contactEndpoint :: Prelude.Text
  }
  deriving (CreateContactMethod -> CreateContactMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateContactMethod -> CreateContactMethod -> Bool
$c/= :: CreateContactMethod -> CreateContactMethod -> Bool
== :: CreateContactMethod -> CreateContactMethod -> Bool
$c== :: CreateContactMethod -> CreateContactMethod -> Bool
Prelude.Eq, ReadPrec [CreateContactMethod]
ReadPrec CreateContactMethod
Int -> ReadS CreateContactMethod
ReadS [CreateContactMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateContactMethod]
$creadListPrec :: ReadPrec [CreateContactMethod]
readPrec :: ReadPrec CreateContactMethod
$creadPrec :: ReadPrec CreateContactMethod
readList :: ReadS [CreateContactMethod]
$creadList :: ReadS [CreateContactMethod]
readsPrec :: Int -> ReadS CreateContactMethod
$creadsPrec :: Int -> ReadS CreateContactMethod
Prelude.Read, Int -> CreateContactMethod -> ShowS
[CreateContactMethod] -> ShowS
CreateContactMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateContactMethod] -> ShowS
$cshowList :: [CreateContactMethod] -> ShowS
show :: CreateContactMethod -> String
$cshow :: CreateContactMethod -> String
showsPrec :: Int -> CreateContactMethod -> ShowS
$cshowsPrec :: Int -> CreateContactMethod -> ShowS
Prelude.Show, forall x. Rep CreateContactMethod x -> CreateContactMethod
forall x. CreateContactMethod -> Rep CreateContactMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateContactMethod x -> CreateContactMethod
$cfrom :: forall x. CreateContactMethod -> Rep CreateContactMethod x
Prelude.Generic)

-- |
-- Create a value of 'CreateContactMethod' 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:
--
-- 'protocol', 'createContactMethod_protocol' - The protocol of the contact method, such as @Email@ or @SMS@ (text
-- messaging).
--
-- The @SMS@ protocol is supported only in the following Amazon Web
-- Services Regions.
--
-- -   US East (N. Virginia) (@us-east-1@)
--
-- -   US West (Oregon) (@us-west-2@)
--
-- -   Europe (Ireland) (@eu-west-1@)
--
-- -   Asia Pacific (Tokyo) (@ap-northeast-1@)
--
-- -   Asia Pacific (Singapore) (@ap-southeast-1@)
--
-- -   Asia Pacific (Sydney) (@ap-southeast-2@)
--
-- For a list of countries\/regions where SMS text messages can be sent,
-- and the latest Amazon Web Services Regions where SMS text messaging is
-- supported, see
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-supported-regions-countries.html Supported Regions and Countries>
-- in the /Amazon SNS Developer Guide/.
--
-- For more information about notifications in Amazon Lightsail, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-notifications Notifications in Amazon Lightsail>.
--
-- 'contactEndpoint', 'createContactMethod_contactEndpoint' - The destination of the contact method, such as an email address or a
-- mobile phone number.
--
-- Use the E.164 format when specifying a mobile phone number. E.164 is a
-- standard for the phone number structure used for international
-- telecommunication. Phone numbers that follow this format can have a
-- maximum of 15 digits, and they are prefixed with the plus character (+)
-- and the country code. For example, a U.S. phone number in E.164 format
-- would be specified as +1XXX5550100. For more information, see
-- <https://en.wikipedia.org/wiki/E.164 E.164> on /Wikipedia/.
newCreateContactMethod ::
  -- | 'protocol'
  ContactProtocol ->
  -- | 'contactEndpoint'
  Prelude.Text ->
  CreateContactMethod
newCreateContactMethod :: ContactProtocol -> Text -> CreateContactMethod
newCreateContactMethod ContactProtocol
pProtocol_ Text
pContactEndpoint_ =
  CreateContactMethod'
    { $sel:protocol:CreateContactMethod' :: ContactProtocol
protocol = ContactProtocol
pProtocol_,
      $sel:contactEndpoint:CreateContactMethod' :: Text
contactEndpoint = Text
pContactEndpoint_
    }

-- | The protocol of the contact method, such as @Email@ or @SMS@ (text
-- messaging).
--
-- The @SMS@ protocol is supported only in the following Amazon Web
-- Services Regions.
--
-- -   US East (N. Virginia) (@us-east-1@)
--
-- -   US West (Oregon) (@us-west-2@)
--
-- -   Europe (Ireland) (@eu-west-1@)
--
-- -   Asia Pacific (Tokyo) (@ap-northeast-1@)
--
-- -   Asia Pacific (Singapore) (@ap-southeast-1@)
--
-- -   Asia Pacific (Sydney) (@ap-southeast-2@)
--
-- For a list of countries\/regions where SMS text messages can be sent,
-- and the latest Amazon Web Services Regions where SMS text messaging is
-- supported, see
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-supported-regions-countries.html Supported Regions and Countries>
-- in the /Amazon SNS Developer Guide/.
--
-- For more information about notifications in Amazon Lightsail, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-notifications Notifications in Amazon Lightsail>.
createContactMethod_protocol :: Lens.Lens' CreateContactMethod ContactProtocol
createContactMethod_protocol :: Lens' CreateContactMethod ContactProtocol
createContactMethod_protocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContactMethod' {ContactProtocol
protocol :: ContactProtocol
$sel:protocol:CreateContactMethod' :: CreateContactMethod -> ContactProtocol
protocol} -> ContactProtocol
protocol) (\s :: CreateContactMethod
s@CreateContactMethod' {} ContactProtocol
a -> CreateContactMethod
s {$sel:protocol:CreateContactMethod' :: ContactProtocol
protocol = ContactProtocol
a} :: CreateContactMethod)

-- | The destination of the contact method, such as an email address or a
-- mobile phone number.
--
-- Use the E.164 format when specifying a mobile phone number. E.164 is a
-- standard for the phone number structure used for international
-- telecommunication. Phone numbers that follow this format can have a
-- maximum of 15 digits, and they are prefixed with the plus character (+)
-- and the country code. For example, a U.S. phone number in E.164 format
-- would be specified as +1XXX5550100. For more information, see
-- <https://en.wikipedia.org/wiki/E.164 E.164> on /Wikipedia/.
createContactMethod_contactEndpoint :: Lens.Lens' CreateContactMethod Prelude.Text
createContactMethod_contactEndpoint :: Lens' CreateContactMethod Text
createContactMethod_contactEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContactMethod' {Text
contactEndpoint :: Text
$sel:contactEndpoint:CreateContactMethod' :: CreateContactMethod -> Text
contactEndpoint} -> Text
contactEndpoint) (\s :: CreateContactMethod
s@CreateContactMethod' {} Text
a -> CreateContactMethod
s {$sel:contactEndpoint:CreateContactMethod' :: Text
contactEndpoint = Text
a} :: CreateContactMethod)

instance Core.AWSRequest CreateContactMethod where
  type
    AWSResponse CreateContactMethod =
      CreateContactMethodResponse
  request :: (Service -> Service)
-> CreateContactMethod -> Request CreateContactMethod
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 CreateContactMethod
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateContactMethod)))
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 [Operation] -> Int -> CreateContactMethodResponse
CreateContactMethodResponse'
            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
"operations" 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 CreateContactMethod where
  hashWithSalt :: Int -> CreateContactMethod -> Int
hashWithSalt Int
_salt CreateContactMethod' {Text
ContactProtocol
contactEndpoint :: Text
protocol :: ContactProtocol
$sel:contactEndpoint:CreateContactMethod' :: CreateContactMethod -> Text
$sel:protocol:CreateContactMethod' :: CreateContactMethod -> ContactProtocol
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ContactProtocol
protocol
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactEndpoint

instance Prelude.NFData CreateContactMethod where
  rnf :: CreateContactMethod -> ()
rnf CreateContactMethod' {Text
ContactProtocol
contactEndpoint :: Text
protocol :: ContactProtocol
$sel:contactEndpoint:CreateContactMethod' :: CreateContactMethod -> Text
$sel:protocol:CreateContactMethod' :: CreateContactMethod -> ContactProtocol
..} =
    forall a. NFData a => a -> ()
Prelude.rnf ContactProtocol
protocol
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contactEndpoint

instance Data.ToHeaders CreateContactMethod where
  toHeaders :: CreateContactMethod -> 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
"Lightsail_20161128.CreateContactMethod" ::
                          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 CreateContactMethod where
  toJSON :: CreateContactMethod -> Value
toJSON CreateContactMethod' {Text
ContactProtocol
contactEndpoint :: Text
protocol :: ContactProtocol
$sel:contactEndpoint:CreateContactMethod' :: CreateContactMethod -> Text
$sel:protocol:CreateContactMethod' :: CreateContactMethod -> ContactProtocol
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"protocol" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ContactProtocol
protocol),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"contactEndpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
contactEndpoint)
          ]
      )

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

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

-- | /See:/ 'newCreateContactMethodResponse' smart constructor.
data CreateContactMethodResponse = CreateContactMethodResponse'
  { -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    CreateContactMethodResponse -> Maybe [Operation]
operations :: Prelude.Maybe [Operation],
    -- | The response's http status code.
    CreateContactMethodResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateContactMethodResponse -> CreateContactMethodResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateContactMethodResponse -> CreateContactMethodResponse -> Bool
$c/= :: CreateContactMethodResponse -> CreateContactMethodResponse -> Bool
== :: CreateContactMethodResponse -> CreateContactMethodResponse -> Bool
$c== :: CreateContactMethodResponse -> CreateContactMethodResponse -> Bool
Prelude.Eq, ReadPrec [CreateContactMethodResponse]
ReadPrec CreateContactMethodResponse
Int -> ReadS CreateContactMethodResponse
ReadS [CreateContactMethodResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateContactMethodResponse]
$creadListPrec :: ReadPrec [CreateContactMethodResponse]
readPrec :: ReadPrec CreateContactMethodResponse
$creadPrec :: ReadPrec CreateContactMethodResponse
readList :: ReadS [CreateContactMethodResponse]
$creadList :: ReadS [CreateContactMethodResponse]
readsPrec :: Int -> ReadS CreateContactMethodResponse
$creadsPrec :: Int -> ReadS CreateContactMethodResponse
Prelude.Read, Int -> CreateContactMethodResponse -> ShowS
[CreateContactMethodResponse] -> ShowS
CreateContactMethodResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateContactMethodResponse] -> ShowS
$cshowList :: [CreateContactMethodResponse] -> ShowS
show :: CreateContactMethodResponse -> String
$cshow :: CreateContactMethodResponse -> String
showsPrec :: Int -> CreateContactMethodResponse -> ShowS
$cshowsPrec :: Int -> CreateContactMethodResponse -> ShowS
Prelude.Show, forall x.
Rep CreateContactMethodResponse x -> CreateContactMethodResponse
forall x.
CreateContactMethodResponse -> Rep CreateContactMethodResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateContactMethodResponse x -> CreateContactMethodResponse
$cfrom :: forall x.
CreateContactMethodResponse -> Rep CreateContactMethodResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateContactMethodResponse' 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:
--
-- 'operations', 'createContactMethodResponse_operations' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'httpStatus', 'createContactMethodResponse_httpStatus' - The response's http status code.
newCreateContactMethodResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateContactMethodResponse
newCreateContactMethodResponse :: Int -> CreateContactMethodResponse
newCreateContactMethodResponse Int
pHttpStatus_ =
  CreateContactMethodResponse'
    { $sel:operations:CreateContactMethodResponse' :: Maybe [Operation]
operations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateContactMethodResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
createContactMethodResponse_operations :: Lens.Lens' CreateContactMethodResponse (Prelude.Maybe [Operation])
createContactMethodResponse_operations :: Lens' CreateContactMethodResponse (Maybe [Operation])
createContactMethodResponse_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContactMethodResponse' {Maybe [Operation]
operations :: Maybe [Operation]
$sel:operations:CreateContactMethodResponse' :: CreateContactMethodResponse -> Maybe [Operation]
operations} -> Maybe [Operation]
operations) (\s :: CreateContactMethodResponse
s@CreateContactMethodResponse' {} Maybe [Operation]
a -> CreateContactMethodResponse
s {$sel:operations:CreateContactMethodResponse' :: Maybe [Operation]
operations = Maybe [Operation]
a} :: CreateContactMethodResponse) 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.
createContactMethodResponse_httpStatus :: Lens.Lens' CreateContactMethodResponse Prelude.Int
createContactMethodResponse_httpStatus :: Lens' CreateContactMethodResponse Int
createContactMethodResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContactMethodResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateContactMethodResponse' :: CreateContactMethodResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateContactMethodResponse
s@CreateContactMethodResponse' {} Int
a -> CreateContactMethodResponse
s {$sel:httpStatus:CreateContactMethodResponse' :: Int
httpStatus = Int
a} :: CreateContactMethodResponse)

instance Prelude.NFData CreateContactMethodResponse where
  rnf :: CreateContactMethodResponse -> ()
rnf CreateContactMethodResponse' {Int
Maybe [Operation]
httpStatus :: Int
operations :: Maybe [Operation]
$sel:httpStatus:CreateContactMethodResponse' :: CreateContactMethodResponse -> Int
$sel:operations:CreateContactMethodResponse' :: CreateContactMethodResponse -> Maybe [Operation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Operation]
operations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus