{-# 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.Connect.MonitorContact
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Initiates silent monitoring of a contact. The Contact Control Panel
-- (CCP) of the user specified by /userId/ will be set to silent monitoring
-- mode on the contact.
module Amazonka.Connect.MonitorContact
  ( -- * Creating a Request
    MonitorContact (..),
    newMonitorContact,

    -- * Request Lenses
    monitorContact_allowedMonitorCapabilities,
    monitorContact_clientToken,
    monitorContact_instanceId,
    monitorContact_contactId,
    monitorContact_userId,

    -- * Destructuring the Response
    MonitorContactResponse (..),
    newMonitorContactResponse,

    -- * Response Lenses
    monitorContactResponse_contactArn,
    monitorContactResponse_contactId,
    monitorContactResponse_httpStatus,
  )
where

import Amazonka.Connect.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:/ 'newMonitorContact' smart constructor.
data MonitorContact = MonitorContact'
  { -- | Specify which monitoring actions the user is allowed to take. For
    -- example, whether the user is allowed to escalate from silent monitoring
    -- to barge.
    MonitorContact -> Maybe [MonitorCapability]
allowedMonitorCapabilities :: Prelude.Maybe [MonitorCapability],
    -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. If not provided, the Amazon Web Services SDK
    -- populates this field. For more information about idempotency, see
    -- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
    MonitorContact -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    MonitorContact -> Text
instanceId :: Prelude.Text,
    -- | The identifier of the contact.
    MonitorContact -> Text
contactId :: Prelude.Text,
    -- | The identifier of the user account.
    MonitorContact -> Text
userId :: Prelude.Text
  }
  deriving (MonitorContact -> MonitorContact -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorContact -> MonitorContact -> Bool
$c/= :: MonitorContact -> MonitorContact -> Bool
== :: MonitorContact -> MonitorContact -> Bool
$c== :: MonitorContact -> MonitorContact -> Bool
Prelude.Eq, ReadPrec [MonitorContact]
ReadPrec MonitorContact
Int -> ReadS MonitorContact
ReadS [MonitorContact]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MonitorContact]
$creadListPrec :: ReadPrec [MonitorContact]
readPrec :: ReadPrec MonitorContact
$creadPrec :: ReadPrec MonitorContact
readList :: ReadS [MonitorContact]
$creadList :: ReadS [MonitorContact]
readsPrec :: Int -> ReadS MonitorContact
$creadsPrec :: Int -> ReadS MonitorContact
Prelude.Read, Int -> MonitorContact -> ShowS
[MonitorContact] -> ShowS
MonitorContact -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MonitorContact] -> ShowS
$cshowList :: [MonitorContact] -> ShowS
show :: MonitorContact -> String
$cshow :: MonitorContact -> String
showsPrec :: Int -> MonitorContact -> ShowS
$cshowsPrec :: Int -> MonitorContact -> ShowS
Prelude.Show, forall x. Rep MonitorContact x -> MonitorContact
forall x. MonitorContact -> Rep MonitorContact x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorContact x -> MonitorContact
$cfrom :: forall x. MonitorContact -> Rep MonitorContact x
Prelude.Generic)

-- |
-- Create a value of 'MonitorContact' 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:
--
-- 'allowedMonitorCapabilities', 'monitorContact_allowedMonitorCapabilities' - Specify which monitoring actions the user is allowed to take. For
-- example, whether the user is allowed to escalate from silent monitoring
-- to barge.
--
-- 'clientToken', 'monitorContact_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If not provided, the Amazon Web Services SDK
-- populates this field. For more information about idempotency, see
-- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
--
-- 'instanceId', 'monitorContact_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
--
-- 'contactId', 'monitorContact_contactId' - The identifier of the contact.
--
-- 'userId', 'monitorContact_userId' - The identifier of the user account.
newMonitorContact ::
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'contactId'
  Prelude.Text ->
  -- | 'userId'
  Prelude.Text ->
  MonitorContact
newMonitorContact :: Text -> Text -> Text -> MonitorContact
newMonitorContact Text
pInstanceId_ Text
pContactId_ Text
pUserId_ =
  MonitorContact'
    { $sel:allowedMonitorCapabilities:MonitorContact' :: Maybe [MonitorCapability]
allowedMonitorCapabilities =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:MonitorContact' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:MonitorContact' :: Text
instanceId = Text
pInstanceId_,
      $sel:contactId:MonitorContact' :: Text
contactId = Text
pContactId_,
      $sel:userId:MonitorContact' :: Text
userId = Text
pUserId_
    }

-- | Specify which monitoring actions the user is allowed to take. For
-- example, whether the user is allowed to escalate from silent monitoring
-- to barge.
monitorContact_allowedMonitorCapabilities :: Lens.Lens' MonitorContact (Prelude.Maybe [MonitorCapability])
monitorContact_allowedMonitorCapabilities :: Lens' MonitorContact (Maybe [MonitorCapability])
monitorContact_allowedMonitorCapabilities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MonitorContact' {Maybe [MonitorCapability]
allowedMonitorCapabilities :: Maybe [MonitorCapability]
$sel:allowedMonitorCapabilities:MonitorContact' :: MonitorContact -> Maybe [MonitorCapability]
allowedMonitorCapabilities} -> Maybe [MonitorCapability]
allowedMonitorCapabilities) (\s :: MonitorContact
s@MonitorContact' {} Maybe [MonitorCapability]
a -> MonitorContact
s {$sel:allowedMonitorCapabilities:MonitorContact' :: Maybe [MonitorCapability]
allowedMonitorCapabilities = Maybe [MonitorCapability]
a} :: MonitorContact) 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

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If not provided, the Amazon Web Services SDK
-- populates this field. For more information about idempotency, see
-- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
monitorContact_clientToken :: Lens.Lens' MonitorContact (Prelude.Maybe Prelude.Text)
monitorContact_clientToken :: Lens' MonitorContact (Maybe Text)
monitorContact_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MonitorContact' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:MonitorContact' :: MonitorContact -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: MonitorContact
s@MonitorContact' {} Maybe Text
a -> MonitorContact
s {$sel:clientToken:MonitorContact' :: Maybe Text
clientToken = Maybe Text
a} :: MonitorContact)

-- | The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
monitorContact_instanceId :: Lens.Lens' MonitorContact Prelude.Text
monitorContact_instanceId :: Lens' MonitorContact Text
monitorContact_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MonitorContact' {Text
instanceId :: Text
$sel:instanceId:MonitorContact' :: MonitorContact -> Text
instanceId} -> Text
instanceId) (\s :: MonitorContact
s@MonitorContact' {} Text
a -> MonitorContact
s {$sel:instanceId:MonitorContact' :: Text
instanceId = Text
a} :: MonitorContact)

-- | The identifier of the contact.
monitorContact_contactId :: Lens.Lens' MonitorContact Prelude.Text
monitorContact_contactId :: Lens' MonitorContact Text
monitorContact_contactId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MonitorContact' {Text
contactId :: Text
$sel:contactId:MonitorContact' :: MonitorContact -> Text
contactId} -> Text
contactId) (\s :: MonitorContact
s@MonitorContact' {} Text
a -> MonitorContact
s {$sel:contactId:MonitorContact' :: Text
contactId = Text
a} :: MonitorContact)

-- | The identifier of the user account.
monitorContact_userId :: Lens.Lens' MonitorContact Prelude.Text
monitorContact_userId :: Lens' MonitorContact Text
monitorContact_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MonitorContact' {Text
userId :: Text
$sel:userId:MonitorContact' :: MonitorContact -> Text
userId} -> Text
userId) (\s :: MonitorContact
s@MonitorContact' {} Text
a -> MonitorContact
s {$sel:userId:MonitorContact' :: Text
userId = Text
a} :: MonitorContact)

instance Core.AWSRequest MonitorContact where
  type
    AWSResponse MonitorContact =
      MonitorContactResponse
  request :: (Service -> Service) -> MonitorContact -> Request MonitorContact
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 MonitorContact
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse MonitorContact)))
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 -> Maybe Text -> Int -> MonitorContactResponse
MonitorContactResponse'
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ContactId")
            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 MonitorContact where
  hashWithSalt :: Int -> MonitorContact -> Int
hashWithSalt Int
_salt MonitorContact' {Maybe [MonitorCapability]
Maybe Text
Text
userId :: Text
contactId :: Text
instanceId :: Text
clientToken :: Maybe Text
allowedMonitorCapabilities :: Maybe [MonitorCapability]
$sel:userId:MonitorContact' :: MonitorContact -> Text
$sel:contactId:MonitorContact' :: MonitorContact -> Text
$sel:instanceId:MonitorContact' :: MonitorContact -> Text
$sel:clientToken:MonitorContact' :: MonitorContact -> Maybe Text
$sel:allowedMonitorCapabilities:MonitorContact' :: MonitorContact -> Maybe [MonitorCapability]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [MonitorCapability]
allowedMonitorCapabilities
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userId

instance Prelude.NFData MonitorContact where
  rnf :: MonitorContact -> ()
rnf MonitorContact' {Maybe [MonitorCapability]
Maybe Text
Text
userId :: Text
contactId :: Text
instanceId :: Text
clientToken :: Maybe Text
allowedMonitorCapabilities :: Maybe [MonitorCapability]
$sel:userId:MonitorContact' :: MonitorContact -> Text
$sel:contactId:MonitorContact' :: MonitorContact -> Text
$sel:instanceId:MonitorContact' :: MonitorContact -> Text
$sel:clientToken:MonitorContact' :: MonitorContact -> Maybe Text
$sel:allowedMonitorCapabilities:MonitorContact' :: MonitorContact -> Maybe [MonitorCapability]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [MonitorCapability]
allowedMonitorCapabilities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contactId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userId

instance Data.ToHeaders MonitorContact where
  toHeaders :: MonitorContact -> 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 MonitorContact where
  toJSON :: MonitorContact -> Value
toJSON MonitorContact' {Maybe [MonitorCapability]
Maybe Text
Text
userId :: Text
contactId :: Text
instanceId :: Text
clientToken :: Maybe Text
allowedMonitorCapabilities :: Maybe [MonitorCapability]
$sel:userId:MonitorContact' :: MonitorContact -> Text
$sel:contactId:MonitorContact' :: MonitorContact -> Text
$sel:instanceId:MonitorContact' :: MonitorContact -> Text
$sel:clientToken:MonitorContact' :: MonitorContact -> Maybe Text
$sel:allowedMonitorCapabilities:MonitorContact' :: MonitorContact -> Maybe [MonitorCapability]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AllowedMonitorCapabilities" 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 [MonitorCapability]
allowedMonitorCapabilities,
            (Key
"ClientToken" 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
clientToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"InstanceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ContactId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
contactId),
            forall a. a -> Maybe a
Prelude.Just (Key
"UserId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userId)
          ]
      )

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

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

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

-- |
-- Create a value of 'MonitorContactResponse' 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', 'monitorContactResponse_contactArn' - The ARN of the contact.
--
-- 'contactId', 'monitorContactResponse_contactId' - The identifier of the contact.
--
-- 'httpStatus', 'monitorContactResponse_httpStatus' - The response's http status code.
newMonitorContactResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  MonitorContactResponse
newMonitorContactResponse :: Int -> MonitorContactResponse
newMonitorContactResponse Int
pHttpStatus_ =
  MonitorContactResponse'
    { $sel:contactArn:MonitorContactResponse' :: Maybe Text
contactArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:contactId:MonitorContactResponse' :: Maybe Text
contactId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:MonitorContactResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the contact.
monitorContactResponse_contactArn :: Lens.Lens' MonitorContactResponse (Prelude.Maybe Prelude.Text)
monitorContactResponse_contactArn :: Lens' MonitorContactResponse (Maybe Text)
monitorContactResponse_contactArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MonitorContactResponse' {Maybe Text
contactArn :: Maybe Text
$sel:contactArn:MonitorContactResponse' :: MonitorContactResponse -> Maybe Text
contactArn} -> Maybe Text
contactArn) (\s :: MonitorContactResponse
s@MonitorContactResponse' {} Maybe Text
a -> MonitorContactResponse
s {$sel:contactArn:MonitorContactResponse' :: Maybe Text
contactArn = Maybe Text
a} :: MonitorContactResponse)

-- | The identifier of the contact.
monitorContactResponse_contactId :: Lens.Lens' MonitorContactResponse (Prelude.Maybe Prelude.Text)
monitorContactResponse_contactId :: Lens' MonitorContactResponse (Maybe Text)
monitorContactResponse_contactId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MonitorContactResponse' {Maybe Text
contactId :: Maybe Text
$sel:contactId:MonitorContactResponse' :: MonitorContactResponse -> Maybe Text
contactId} -> Maybe Text
contactId) (\s :: MonitorContactResponse
s@MonitorContactResponse' {} Maybe Text
a -> MonitorContactResponse
s {$sel:contactId:MonitorContactResponse' :: Maybe Text
contactId = Maybe Text
a} :: MonitorContactResponse)

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

instance Prelude.NFData MonitorContactResponse where
  rnf :: MonitorContactResponse -> ()
rnf MonitorContactResponse' {Int
Maybe Text
httpStatus :: Int
contactId :: Maybe Text
contactArn :: Maybe Text
$sel:httpStatus:MonitorContactResponse' :: MonitorContactResponse -> Int
$sel:contactId:MonitorContactResponse' :: MonitorContactResponse -> Maybe Text
$sel:contactArn:MonitorContactResponse' :: MonitorContactResponse -> 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 Maybe Text
contactId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus