{-# 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.CustomerProfiles.PutProfileObject
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds additional objects to customer profiles of a given ObjectType.
--
-- When adding a specific profile object, like a Contact Record, an
-- inferred profile can get created if it is not mapped to an existing
-- profile. The resulting profile will only have a phone number populated
-- in the standard ProfileObject. Any additional Contact Records with the
-- same phone number will be mapped to the same inferred profile.
--
-- When a ProfileObject is created and if a ProfileObjectType already
-- exists for the ProfileObject, it will provide data to a standard profile
-- depending on the ProfileObjectType definition.
--
-- PutProfileObject needs an ObjectType, which can be created using
-- PutProfileObjectType.
module Amazonka.CustomerProfiles.PutProfileObject
  ( -- * Creating a Request
    PutProfileObject (..),
    newPutProfileObject,

    -- * Request Lenses
    putProfileObject_objectTypeName,
    putProfileObject_object,
    putProfileObject_domainName,

    -- * Destructuring the Response
    PutProfileObjectResponse (..),
    newPutProfileObjectResponse,

    -- * Response Lenses
    putProfileObjectResponse_profileObjectUniqueKey,
    putProfileObjectResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.CustomerProfiles.Types
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:/ 'newPutProfileObject' smart constructor.
data PutProfileObject = PutProfileObject'
  { -- | The name of the profile object type.
    PutProfileObject -> Text
objectTypeName :: Prelude.Text,
    -- | A string that is serialized from a JSON object.
    PutProfileObject -> Text
object' :: Prelude.Text,
    -- | The unique name of the domain.
    PutProfileObject -> Text
domainName :: Prelude.Text
  }
  deriving (PutProfileObject -> PutProfileObject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutProfileObject -> PutProfileObject -> Bool
$c/= :: PutProfileObject -> PutProfileObject -> Bool
== :: PutProfileObject -> PutProfileObject -> Bool
$c== :: PutProfileObject -> PutProfileObject -> Bool
Prelude.Eq, ReadPrec [PutProfileObject]
ReadPrec PutProfileObject
Int -> ReadS PutProfileObject
ReadS [PutProfileObject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutProfileObject]
$creadListPrec :: ReadPrec [PutProfileObject]
readPrec :: ReadPrec PutProfileObject
$creadPrec :: ReadPrec PutProfileObject
readList :: ReadS [PutProfileObject]
$creadList :: ReadS [PutProfileObject]
readsPrec :: Int -> ReadS PutProfileObject
$creadsPrec :: Int -> ReadS PutProfileObject
Prelude.Read, Int -> PutProfileObject -> ShowS
[PutProfileObject] -> ShowS
PutProfileObject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutProfileObject] -> ShowS
$cshowList :: [PutProfileObject] -> ShowS
show :: PutProfileObject -> String
$cshow :: PutProfileObject -> String
showsPrec :: Int -> PutProfileObject -> ShowS
$cshowsPrec :: Int -> PutProfileObject -> ShowS
Prelude.Show, forall x. Rep PutProfileObject x -> PutProfileObject
forall x. PutProfileObject -> Rep PutProfileObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutProfileObject x -> PutProfileObject
$cfrom :: forall x. PutProfileObject -> Rep PutProfileObject x
Prelude.Generic)

-- |
-- Create a value of 'PutProfileObject' 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:
--
-- 'objectTypeName', 'putProfileObject_objectTypeName' - The name of the profile object type.
--
-- 'object'', 'putProfileObject_object' - A string that is serialized from a JSON object.
--
-- 'domainName', 'putProfileObject_domainName' - The unique name of the domain.
newPutProfileObject ::
  -- | 'objectTypeName'
  Prelude.Text ->
  -- | 'object''
  Prelude.Text ->
  -- | 'domainName'
  Prelude.Text ->
  PutProfileObject
newPutProfileObject :: Text -> Text -> Text -> PutProfileObject
newPutProfileObject
  Text
pObjectTypeName_
  Text
pObject_
  Text
pDomainName_ =
    PutProfileObject'
      { $sel:objectTypeName:PutProfileObject' :: Text
objectTypeName =
          Text
pObjectTypeName_,
        $sel:object':PutProfileObject' :: Text
object' = Text
pObject_,
        $sel:domainName:PutProfileObject' :: Text
domainName = Text
pDomainName_
      }

-- | The name of the profile object type.
putProfileObject_objectTypeName :: Lens.Lens' PutProfileObject Prelude.Text
putProfileObject_objectTypeName :: Lens' PutProfileObject Text
putProfileObject_objectTypeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObject' {Text
objectTypeName :: Text
$sel:objectTypeName:PutProfileObject' :: PutProfileObject -> Text
objectTypeName} -> Text
objectTypeName) (\s :: PutProfileObject
s@PutProfileObject' {} Text
a -> PutProfileObject
s {$sel:objectTypeName:PutProfileObject' :: Text
objectTypeName = Text
a} :: PutProfileObject)

-- | A string that is serialized from a JSON object.
putProfileObject_object :: Lens.Lens' PutProfileObject Prelude.Text
putProfileObject_object :: Lens' PutProfileObject Text
putProfileObject_object = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObject' {Text
object' :: Text
$sel:object':PutProfileObject' :: PutProfileObject -> Text
object'} -> Text
object') (\s :: PutProfileObject
s@PutProfileObject' {} Text
a -> PutProfileObject
s {$sel:object':PutProfileObject' :: Text
object' = Text
a} :: PutProfileObject)

-- | The unique name of the domain.
putProfileObject_domainName :: Lens.Lens' PutProfileObject Prelude.Text
putProfileObject_domainName :: Lens' PutProfileObject Text
putProfileObject_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObject' {Text
domainName :: Text
$sel:domainName:PutProfileObject' :: PutProfileObject -> Text
domainName} -> Text
domainName) (\s :: PutProfileObject
s@PutProfileObject' {} Text
a -> PutProfileObject
s {$sel:domainName:PutProfileObject' :: Text
domainName = Text
a} :: PutProfileObject)

instance Core.AWSRequest PutProfileObject where
  type
    AWSResponse PutProfileObject =
      PutProfileObjectResponse
  request :: (Service -> Service)
-> PutProfileObject -> Request PutProfileObject
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutProfileObject
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutProfileObject)))
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 -> PutProfileObjectResponse
PutProfileObjectResponse'
            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
"ProfileObjectUniqueKey")
            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 PutProfileObject where
  hashWithSalt :: Int -> PutProfileObject -> Int
hashWithSalt Int
_salt PutProfileObject' {Text
domainName :: Text
object' :: Text
objectTypeName :: Text
$sel:domainName:PutProfileObject' :: PutProfileObject -> Text
$sel:object':PutProfileObject' :: PutProfileObject -> Text
$sel:objectTypeName:PutProfileObject' :: PutProfileObject -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
objectTypeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
object'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData PutProfileObject where
  rnf :: PutProfileObject -> ()
rnf PutProfileObject' {Text
domainName :: Text
object' :: Text
objectTypeName :: Text
$sel:domainName:PutProfileObject' :: PutProfileObject -> Text
$sel:object':PutProfileObject' :: PutProfileObject -> Text
$sel:objectTypeName:PutProfileObject' :: PutProfileObject -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
objectTypeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
object'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

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

instance Data.ToPath PutProfileObject where
  toPath :: PutProfileObject -> ByteString
toPath PutProfileObject' {Text
domainName :: Text
object' :: Text
objectTypeName :: Text
$sel:domainName:PutProfileObject' :: PutProfileObject -> Text
$sel:object':PutProfileObject' :: PutProfileObject -> Text
$sel:objectTypeName:PutProfileObject' :: PutProfileObject -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domains/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
        ByteString
"/profiles/objects"
      ]

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

-- | /See:/ 'newPutProfileObjectResponse' smart constructor.
data PutProfileObjectResponse = PutProfileObjectResponse'
  { -- | The unique identifier of the profile object generated by the service.
    PutProfileObjectResponse -> Maybe Text
profileObjectUniqueKey :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PutProfileObjectResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutProfileObjectResponse -> PutProfileObjectResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutProfileObjectResponse -> PutProfileObjectResponse -> Bool
$c/= :: PutProfileObjectResponse -> PutProfileObjectResponse -> Bool
== :: PutProfileObjectResponse -> PutProfileObjectResponse -> Bool
$c== :: PutProfileObjectResponse -> PutProfileObjectResponse -> Bool
Prelude.Eq, ReadPrec [PutProfileObjectResponse]
ReadPrec PutProfileObjectResponse
Int -> ReadS PutProfileObjectResponse
ReadS [PutProfileObjectResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutProfileObjectResponse]
$creadListPrec :: ReadPrec [PutProfileObjectResponse]
readPrec :: ReadPrec PutProfileObjectResponse
$creadPrec :: ReadPrec PutProfileObjectResponse
readList :: ReadS [PutProfileObjectResponse]
$creadList :: ReadS [PutProfileObjectResponse]
readsPrec :: Int -> ReadS PutProfileObjectResponse
$creadsPrec :: Int -> ReadS PutProfileObjectResponse
Prelude.Read, Int -> PutProfileObjectResponse -> ShowS
[PutProfileObjectResponse] -> ShowS
PutProfileObjectResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutProfileObjectResponse] -> ShowS
$cshowList :: [PutProfileObjectResponse] -> ShowS
show :: PutProfileObjectResponse -> String
$cshow :: PutProfileObjectResponse -> String
showsPrec :: Int -> PutProfileObjectResponse -> ShowS
$cshowsPrec :: Int -> PutProfileObjectResponse -> ShowS
Prelude.Show, forall x.
Rep PutProfileObjectResponse x -> PutProfileObjectResponse
forall x.
PutProfileObjectResponse -> Rep PutProfileObjectResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutProfileObjectResponse x -> PutProfileObjectResponse
$cfrom :: forall x.
PutProfileObjectResponse -> Rep PutProfileObjectResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutProfileObjectResponse' 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:
--
-- 'profileObjectUniqueKey', 'putProfileObjectResponse_profileObjectUniqueKey' - The unique identifier of the profile object generated by the service.
--
-- 'httpStatus', 'putProfileObjectResponse_httpStatus' - The response's http status code.
newPutProfileObjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutProfileObjectResponse
newPutProfileObjectResponse :: Int -> PutProfileObjectResponse
newPutProfileObjectResponse Int
pHttpStatus_ =
  PutProfileObjectResponse'
    { $sel:profileObjectUniqueKey:PutProfileObjectResponse' :: Maybe Text
profileObjectUniqueKey =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutProfileObjectResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique identifier of the profile object generated by the service.
putProfileObjectResponse_profileObjectUniqueKey :: Lens.Lens' PutProfileObjectResponse (Prelude.Maybe Prelude.Text)
putProfileObjectResponse_profileObjectUniqueKey :: Lens' PutProfileObjectResponse (Maybe Text)
putProfileObjectResponse_profileObjectUniqueKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutProfileObjectResponse' {Maybe Text
profileObjectUniqueKey :: Maybe Text
$sel:profileObjectUniqueKey:PutProfileObjectResponse' :: PutProfileObjectResponse -> Maybe Text
profileObjectUniqueKey} -> Maybe Text
profileObjectUniqueKey) (\s :: PutProfileObjectResponse
s@PutProfileObjectResponse' {} Maybe Text
a -> PutProfileObjectResponse
s {$sel:profileObjectUniqueKey:PutProfileObjectResponse' :: Maybe Text
profileObjectUniqueKey = Maybe Text
a} :: PutProfileObjectResponse)

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

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