{-# 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.AlexaBusiness.CreateContact
-- 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 contact with the specified details.
module Amazonka.AlexaBusiness.CreateContact
  ( -- * Creating a Request
    CreateContact (..),
    newCreateContact,

    -- * Request Lenses
    createContact_clientRequestToken,
    createContact_displayName,
    createContact_lastName,
    createContact_phoneNumber,
    createContact_phoneNumbers,
    createContact_sipAddresses,
    createContact_tags,
    createContact_firstName,

    -- * Destructuring the Response
    CreateContactResponse (..),
    newCreateContactResponse,

    -- * Response Lenses
    createContactResponse_contactArn,
    createContactResponse_httpStatus,
  )
where

import Amazonka.AlexaBusiness.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:/ 'newCreateContact' smart constructor.
data CreateContact = CreateContact'
  { -- | A unique, user-specified identifier for this request that ensures
    -- idempotency.
    CreateContact -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the contact to display on the console.
    CreateContact -> Maybe Text
displayName :: Prelude.Maybe Prelude.Text,
    -- | The last name of the contact that is used to call the contact on the
    -- device.
    CreateContact -> Maybe Text
lastName :: Prelude.Maybe Prelude.Text,
    -- | The phone number of the contact in E.164 format. The phone number type
    -- defaults to WORK. You can specify PhoneNumber or PhoneNumbers. We
    -- recommend that you use PhoneNumbers, which lets you specify the phone
    -- number type and multiple numbers.
    CreateContact -> Maybe (Sensitive Text)
phoneNumber :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The list of phone numbers for the contact.
    CreateContact -> Maybe [PhoneNumber]
phoneNumbers :: Prelude.Maybe [PhoneNumber],
    -- | The list of SIP addresses for the contact.
    CreateContact -> Maybe [SipAddress]
sipAddresses :: Prelude.Maybe [SipAddress],
    -- | The tags to be added to the specified resource. Do not provide system
    -- tags.
    CreateContact -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The first name of the contact that is used to call the contact on the
    -- device.
    CreateContact -> Text
firstName :: Prelude.Text
  }
  deriving (CreateContact -> CreateContact -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateContact -> CreateContact -> Bool
$c/= :: CreateContact -> CreateContact -> Bool
== :: CreateContact -> CreateContact -> Bool
$c== :: CreateContact -> CreateContact -> Bool
Prelude.Eq, Int -> CreateContact -> ShowS
[CreateContact] -> ShowS
CreateContact -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateContact] -> ShowS
$cshowList :: [CreateContact] -> ShowS
show :: CreateContact -> String
$cshow :: CreateContact -> String
showsPrec :: Int -> CreateContact -> ShowS
$cshowsPrec :: Int -> CreateContact -> ShowS
Prelude.Show, forall x. Rep CreateContact x -> CreateContact
forall x. CreateContact -> Rep CreateContact x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateContact x -> CreateContact
$cfrom :: forall x. CreateContact -> Rep CreateContact x
Prelude.Generic)

-- |
-- Create a value of 'CreateContact' 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:
--
-- 'clientRequestToken', 'createContact_clientRequestToken' - A unique, user-specified identifier for this request that ensures
-- idempotency.
--
-- 'displayName', 'createContact_displayName' - The name of the contact to display on the console.
--
-- 'lastName', 'createContact_lastName' - The last name of the contact that is used to call the contact on the
-- device.
--
-- 'phoneNumber', 'createContact_phoneNumber' - The phone number of the contact in E.164 format. The phone number type
-- defaults to WORK. You can specify PhoneNumber or PhoneNumbers. We
-- recommend that you use PhoneNumbers, which lets you specify the phone
-- number type and multiple numbers.
--
-- 'phoneNumbers', 'createContact_phoneNumbers' - The list of phone numbers for the contact.
--
-- 'sipAddresses', 'createContact_sipAddresses' - The list of SIP addresses for the contact.
--
-- 'tags', 'createContact_tags' - The tags to be added to the specified resource. Do not provide system
-- tags.
--
-- 'firstName', 'createContact_firstName' - The first name of the contact that is used to call the contact on the
-- device.
newCreateContact ::
  -- | 'firstName'
  Prelude.Text ->
  CreateContact
newCreateContact :: Text -> CreateContact
newCreateContact Text
pFirstName_ =
  CreateContact'
    { $sel:clientRequestToken:CreateContact' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:displayName:CreateContact' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:lastName:CreateContact' :: Maybe Text
lastName = forall a. Maybe a
Prelude.Nothing,
      $sel:phoneNumber:CreateContact' :: Maybe (Sensitive Text)
phoneNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:phoneNumbers:CreateContact' :: Maybe [PhoneNumber]
phoneNumbers = forall a. Maybe a
Prelude.Nothing,
      $sel:sipAddresses:CreateContact' :: Maybe [SipAddress]
sipAddresses = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateContact' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:firstName:CreateContact' :: Text
firstName = Text
pFirstName_
    }

-- | A unique, user-specified identifier for this request that ensures
-- idempotency.
createContact_clientRequestToken :: Lens.Lens' CreateContact (Prelude.Maybe Prelude.Text)
createContact_clientRequestToken :: Lens' CreateContact (Maybe Text)
createContact_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContact' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateContact' :: CreateContact -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateContact
s@CreateContact' {} Maybe Text
a -> CreateContact
s {$sel:clientRequestToken:CreateContact' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateContact)

-- | The name of the contact to display on the console.
createContact_displayName :: Lens.Lens' CreateContact (Prelude.Maybe Prelude.Text)
createContact_displayName :: Lens' CreateContact (Maybe Text)
createContact_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContact' {Maybe Text
displayName :: Maybe Text
$sel:displayName:CreateContact' :: CreateContact -> Maybe Text
displayName} -> Maybe Text
displayName) (\s :: CreateContact
s@CreateContact' {} Maybe Text
a -> CreateContact
s {$sel:displayName:CreateContact' :: Maybe Text
displayName = Maybe Text
a} :: CreateContact)

-- | The last name of the contact that is used to call the contact on the
-- device.
createContact_lastName :: Lens.Lens' CreateContact (Prelude.Maybe Prelude.Text)
createContact_lastName :: Lens' CreateContact (Maybe Text)
createContact_lastName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContact' {Maybe Text
lastName :: Maybe Text
$sel:lastName:CreateContact' :: CreateContact -> Maybe Text
lastName} -> Maybe Text
lastName) (\s :: CreateContact
s@CreateContact' {} Maybe Text
a -> CreateContact
s {$sel:lastName:CreateContact' :: Maybe Text
lastName = Maybe Text
a} :: CreateContact)

-- | The phone number of the contact in E.164 format. The phone number type
-- defaults to WORK. You can specify PhoneNumber or PhoneNumbers. We
-- recommend that you use PhoneNumbers, which lets you specify the phone
-- number type and multiple numbers.
createContact_phoneNumber :: Lens.Lens' CreateContact (Prelude.Maybe Prelude.Text)
createContact_phoneNumber :: Lens' CreateContact (Maybe Text)
createContact_phoneNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContact' {Maybe (Sensitive Text)
phoneNumber :: Maybe (Sensitive Text)
$sel:phoneNumber:CreateContact' :: CreateContact -> Maybe (Sensitive Text)
phoneNumber} -> Maybe (Sensitive Text)
phoneNumber) (\s :: CreateContact
s@CreateContact' {} Maybe (Sensitive Text)
a -> CreateContact
s {$sel:phoneNumber:CreateContact' :: Maybe (Sensitive Text)
phoneNumber = Maybe (Sensitive Text)
a} :: CreateContact) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The list of phone numbers for the contact.
createContact_phoneNumbers :: Lens.Lens' CreateContact (Prelude.Maybe [PhoneNumber])
createContact_phoneNumbers :: Lens' CreateContact (Maybe [PhoneNumber])
createContact_phoneNumbers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContact' {Maybe [PhoneNumber]
phoneNumbers :: Maybe [PhoneNumber]
$sel:phoneNumbers:CreateContact' :: CreateContact -> Maybe [PhoneNumber]
phoneNumbers} -> Maybe [PhoneNumber]
phoneNumbers) (\s :: CreateContact
s@CreateContact' {} Maybe [PhoneNumber]
a -> CreateContact
s {$sel:phoneNumbers:CreateContact' :: Maybe [PhoneNumber]
phoneNumbers = Maybe [PhoneNumber]
a} :: CreateContact) 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 list of SIP addresses for the contact.
createContact_sipAddresses :: Lens.Lens' CreateContact (Prelude.Maybe [SipAddress])
createContact_sipAddresses :: Lens' CreateContact (Maybe [SipAddress])
createContact_sipAddresses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContact' {Maybe [SipAddress]
sipAddresses :: Maybe [SipAddress]
$sel:sipAddresses:CreateContact' :: CreateContact -> Maybe [SipAddress]
sipAddresses} -> Maybe [SipAddress]
sipAddresses) (\s :: CreateContact
s@CreateContact' {} Maybe [SipAddress]
a -> CreateContact
s {$sel:sipAddresses:CreateContact' :: Maybe [SipAddress]
sipAddresses = Maybe [SipAddress]
a} :: CreateContact) 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 tags to be added to the specified resource. Do not provide system
-- tags.
createContact_tags :: Lens.Lens' CreateContact (Prelude.Maybe [Tag])
createContact_tags :: Lens' CreateContact (Maybe [Tag])
createContact_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContact' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateContact' :: CreateContact -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateContact
s@CreateContact' {} Maybe [Tag]
a -> CreateContact
s {$sel:tags:CreateContact' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateContact) 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 first name of the contact that is used to call the contact on the
-- device.
createContact_firstName :: Lens.Lens' CreateContact Prelude.Text
createContact_firstName :: Lens' CreateContact Text
createContact_firstName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContact' {Text
firstName :: Text
$sel:firstName:CreateContact' :: CreateContact -> Text
firstName} -> Text
firstName) (\s :: CreateContact
s@CreateContact' {} Text
a -> CreateContact
s {$sel:firstName:CreateContact' :: Text
firstName = Text
a} :: CreateContact)

instance Core.AWSRequest CreateContact where
  type
    AWSResponse CreateContact =
      CreateContactResponse
  request :: (Service -> Service) -> CreateContact -> Request CreateContact
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 CreateContact
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateContact)))
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 -> Int -> CreateContactResponse
CreateContactResponse'
            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
"ContactArn")
            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 CreateContact where
  hashWithSalt :: Int -> CreateContact -> Int
hashWithSalt Int
_salt CreateContact' {Maybe [PhoneNumber]
Maybe [SipAddress]
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
firstName :: Text
tags :: Maybe [Tag]
sipAddresses :: Maybe [SipAddress]
phoneNumbers :: Maybe [PhoneNumber]
phoneNumber :: Maybe (Sensitive Text)
lastName :: Maybe Text
displayName :: Maybe Text
clientRequestToken :: Maybe Text
$sel:firstName:CreateContact' :: CreateContact -> Text
$sel:tags:CreateContact' :: CreateContact -> Maybe [Tag]
$sel:sipAddresses:CreateContact' :: CreateContact -> Maybe [SipAddress]
$sel:phoneNumbers:CreateContact' :: CreateContact -> Maybe [PhoneNumber]
$sel:phoneNumber:CreateContact' :: CreateContact -> Maybe (Sensitive Text)
$sel:lastName:CreateContact' :: CreateContact -> Maybe Text
$sel:displayName:CreateContact' :: CreateContact -> Maybe Text
$sel:clientRequestToken:CreateContact' :: CreateContact -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
lastName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
phoneNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PhoneNumber]
phoneNumbers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SipAddress]
sipAddresses
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
firstName

instance Prelude.NFData CreateContact where
  rnf :: CreateContact -> ()
rnf CreateContact' {Maybe [PhoneNumber]
Maybe [SipAddress]
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
firstName :: Text
tags :: Maybe [Tag]
sipAddresses :: Maybe [SipAddress]
phoneNumbers :: Maybe [PhoneNumber]
phoneNumber :: Maybe (Sensitive Text)
lastName :: Maybe Text
displayName :: Maybe Text
clientRequestToken :: Maybe Text
$sel:firstName:CreateContact' :: CreateContact -> Text
$sel:tags:CreateContact' :: CreateContact -> Maybe [Tag]
$sel:sipAddresses:CreateContact' :: CreateContact -> Maybe [SipAddress]
$sel:phoneNumbers:CreateContact' :: CreateContact -> Maybe [PhoneNumber]
$sel:phoneNumber:CreateContact' :: CreateContact -> Maybe (Sensitive Text)
$sel:lastName:CreateContact' :: CreateContact -> Maybe Text
$sel:displayName:CreateContact' :: CreateContact -> Maybe Text
$sel:clientRequestToken:CreateContact' :: CreateContact -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
displayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lastName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
phoneNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PhoneNumber]
phoneNumbers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SipAddress]
sipAddresses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
firstName

instance Data.ToHeaders CreateContact where
  toHeaders :: CreateContact -> 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
"AlexaForBusiness.CreateContact" ::
                          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 CreateContact where
  toJSON :: CreateContact -> Value
toJSON CreateContact' {Maybe [PhoneNumber]
Maybe [SipAddress]
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
firstName :: Text
tags :: Maybe [Tag]
sipAddresses :: Maybe [SipAddress]
phoneNumbers :: Maybe [PhoneNumber]
phoneNumber :: Maybe (Sensitive Text)
lastName :: Maybe Text
displayName :: Maybe Text
clientRequestToken :: Maybe Text
$sel:firstName:CreateContact' :: CreateContact -> Text
$sel:tags:CreateContact' :: CreateContact -> Maybe [Tag]
$sel:sipAddresses:CreateContact' :: CreateContact -> Maybe [SipAddress]
$sel:phoneNumbers:CreateContact' :: CreateContact -> Maybe [PhoneNumber]
$sel:phoneNumber:CreateContact' :: CreateContact -> Maybe (Sensitive Text)
$sel:lastName:CreateContact' :: CreateContact -> Maybe Text
$sel:displayName:CreateContact' :: CreateContact -> Maybe Text
$sel:clientRequestToken:CreateContact' :: CreateContact -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (Key
"DisplayName" 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
displayName,
            (Key
"LastName" 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
lastName,
            (Key
"PhoneNumber" 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 (Sensitive Text)
phoneNumber,
            (Key
"PhoneNumbers" 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 [PhoneNumber]
phoneNumbers,
            (Key
"SipAddresses" 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 [SipAddress]
sipAddresses,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"FirstName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
firstName)
          ]
      )

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

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

-- | /See:/ 'newCreateContactResponse' smart constructor.
data CreateContactResponse = CreateContactResponse'
  { -- | The ARN of the newly created address book.
    CreateContactResponse -> Maybe Text
contactArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateContactResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateContactResponse -> CreateContactResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateContactResponse -> CreateContactResponse -> Bool
$c/= :: CreateContactResponse -> CreateContactResponse -> Bool
== :: CreateContactResponse -> CreateContactResponse -> Bool
$c== :: CreateContactResponse -> CreateContactResponse -> Bool
Prelude.Eq, ReadPrec [CreateContactResponse]
ReadPrec CreateContactResponse
Int -> ReadS CreateContactResponse
ReadS [CreateContactResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateContactResponse]
$creadListPrec :: ReadPrec [CreateContactResponse]
readPrec :: ReadPrec CreateContactResponse
$creadPrec :: ReadPrec CreateContactResponse
readList :: ReadS [CreateContactResponse]
$creadList :: ReadS [CreateContactResponse]
readsPrec :: Int -> ReadS CreateContactResponse
$creadsPrec :: Int -> ReadS CreateContactResponse
Prelude.Read, Int -> CreateContactResponse -> ShowS
[CreateContactResponse] -> ShowS
CreateContactResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateContactResponse] -> ShowS
$cshowList :: [CreateContactResponse] -> ShowS
show :: CreateContactResponse -> String
$cshow :: CreateContactResponse -> String
showsPrec :: Int -> CreateContactResponse -> ShowS
$cshowsPrec :: Int -> CreateContactResponse -> ShowS
Prelude.Show, forall x. Rep CreateContactResponse x -> CreateContactResponse
forall x. CreateContactResponse -> Rep CreateContactResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateContactResponse x -> CreateContactResponse
$cfrom :: forall x. CreateContactResponse -> Rep CreateContactResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateContactResponse' 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:
--
-- 'contactArn', 'createContactResponse_contactArn' - The ARN of the newly created address book.
--
-- 'httpStatus', 'createContactResponse_httpStatus' - The response's http status code.
newCreateContactResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateContactResponse
newCreateContactResponse :: Int -> CreateContactResponse
newCreateContactResponse Int
pHttpStatus_ =
  CreateContactResponse'
    { $sel:contactArn:CreateContactResponse' :: Maybe Text
contactArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateContactResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the newly created address book.
createContactResponse_contactArn :: Lens.Lens' CreateContactResponse (Prelude.Maybe Prelude.Text)
createContactResponse_contactArn :: Lens' CreateContactResponse (Maybe Text)
createContactResponse_contactArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContactResponse' {Maybe Text
contactArn :: Maybe Text
$sel:contactArn:CreateContactResponse' :: CreateContactResponse -> Maybe Text
contactArn} -> Maybe Text
contactArn) (\s :: CreateContactResponse
s@CreateContactResponse' {} Maybe Text
a -> CreateContactResponse
s {$sel:contactArn:CreateContactResponse' :: Maybe Text
contactArn = Maybe Text
a} :: CreateContactResponse)

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

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