{-# 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.SSMContacts.GetContact
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about the specified contact or escalation plan.
module Amazonka.SSMContacts.GetContact
  ( -- * Creating a Request
    GetContact (..),
    newGetContact,

    -- * Request Lenses
    getContact_contactId,

    -- * Destructuring the Response
    GetContactResponse (..),
    newGetContactResponse,

    -- * Response Lenses
    getContactResponse_displayName,
    getContactResponse_httpStatus,
    getContactResponse_contactArn,
    getContactResponse_alias,
    getContactResponse_type,
    getContactResponse_plan,
  )
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.SSMContacts.Types

-- | /See:/ 'newGetContact' smart constructor.
data GetContact = GetContact'
  { -- | The Amazon Resource Name (ARN) of the contact or escalation plan.
    GetContact -> Text
contactId :: Prelude.Text
  }
  deriving (GetContact -> GetContact -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContact -> GetContact -> Bool
$c/= :: GetContact -> GetContact -> Bool
== :: GetContact -> GetContact -> Bool
$c== :: GetContact -> GetContact -> Bool
Prelude.Eq, ReadPrec [GetContact]
ReadPrec GetContact
Int -> ReadS GetContact
ReadS [GetContact]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContact]
$creadListPrec :: ReadPrec [GetContact]
readPrec :: ReadPrec GetContact
$creadPrec :: ReadPrec GetContact
readList :: ReadS [GetContact]
$creadList :: ReadS [GetContact]
readsPrec :: Int -> ReadS GetContact
$creadsPrec :: Int -> ReadS GetContact
Prelude.Read, Int -> GetContact -> ShowS
[GetContact] -> ShowS
GetContact -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContact] -> ShowS
$cshowList :: [GetContact] -> ShowS
show :: GetContact -> String
$cshow :: GetContact -> String
showsPrec :: Int -> GetContact -> ShowS
$cshowsPrec :: Int -> GetContact -> ShowS
Prelude.Show, forall x. Rep GetContact x -> GetContact
forall x. GetContact -> Rep GetContact x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetContact x -> GetContact
$cfrom :: forall x. GetContact -> Rep GetContact x
Prelude.Generic)

-- |
-- Create a value of 'GetContact' 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:
--
-- 'contactId', 'getContact_contactId' - The Amazon Resource Name (ARN) of the contact or escalation plan.
newGetContact ::
  -- | 'contactId'
  Prelude.Text ->
  GetContact
newGetContact :: Text -> GetContact
newGetContact Text
pContactId_ =
  GetContact' {$sel:contactId:GetContact' :: Text
contactId = Text
pContactId_}

-- | The Amazon Resource Name (ARN) of the contact or escalation plan.
getContact_contactId :: Lens.Lens' GetContact Prelude.Text
getContact_contactId :: Lens' GetContact Text
getContact_contactId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContact' {Text
contactId :: Text
$sel:contactId:GetContact' :: GetContact -> Text
contactId} -> Text
contactId) (\s :: GetContact
s@GetContact' {} Text
a -> GetContact
s {$sel:contactId:GetContact' :: Text
contactId = Text
a} :: GetContact)

instance Core.AWSRequest GetContact where
  type AWSResponse GetContact = GetContactResponse
  request :: (Service -> Service) -> GetContact -> Request GetContact
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 GetContact
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetContact)))
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 -> Text -> Text -> ContactType -> Plan -> GetContactResponse
GetContactResponse'
            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
"DisplayName")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String 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 a
Data..:> Key
"Alias")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Type")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Plan")
      )

instance Prelude.Hashable GetContact where
  hashWithSalt :: Int -> GetContact -> Int
hashWithSalt Int
_salt GetContact' {Text
contactId :: Text
$sel:contactId:GetContact' :: GetContact -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactId

instance Prelude.NFData GetContact where
  rnf :: GetContact -> ()
rnf GetContact' {Text
contactId :: Text
$sel:contactId:GetContact' :: GetContact -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
contactId

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

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

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

-- | /See:/ 'newGetContactResponse' smart constructor.
data GetContactResponse = GetContactResponse'
  { -- | The full name of the contact or escalation plan.
    GetContactResponse -> Maybe Text
displayName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetContactResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ARN of the contact or escalation plan.
    GetContactResponse -> Text
contactArn :: Prelude.Text,
    -- | The alias of the contact or escalation plan. The alias is unique and
    -- identifiable.
    GetContactResponse -> Text
alias :: Prelude.Text,
    -- | The type of contact, either @PERSONAL@ or @ESCALATION@.
    GetContactResponse -> ContactType
type' :: ContactType,
    -- | Details about the specific timing or stages and targets of the
    -- escalation plan or engagement plan.
    GetContactResponse -> Plan
plan :: Plan
  }
  deriving (GetContactResponse -> GetContactResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContactResponse -> GetContactResponse -> Bool
$c/= :: GetContactResponse -> GetContactResponse -> Bool
== :: GetContactResponse -> GetContactResponse -> Bool
$c== :: GetContactResponse -> GetContactResponse -> Bool
Prelude.Eq, ReadPrec [GetContactResponse]
ReadPrec GetContactResponse
Int -> ReadS GetContactResponse
ReadS [GetContactResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContactResponse]
$creadListPrec :: ReadPrec [GetContactResponse]
readPrec :: ReadPrec GetContactResponse
$creadPrec :: ReadPrec GetContactResponse
readList :: ReadS [GetContactResponse]
$creadList :: ReadS [GetContactResponse]
readsPrec :: Int -> ReadS GetContactResponse
$creadsPrec :: Int -> ReadS GetContactResponse
Prelude.Read, Int -> GetContactResponse -> ShowS
[GetContactResponse] -> ShowS
GetContactResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContactResponse] -> ShowS
$cshowList :: [GetContactResponse] -> ShowS
show :: GetContactResponse -> String
$cshow :: GetContactResponse -> String
showsPrec :: Int -> GetContactResponse -> ShowS
$cshowsPrec :: Int -> GetContactResponse -> ShowS
Prelude.Show, forall x. Rep GetContactResponse x -> GetContactResponse
forall x. GetContactResponse -> Rep GetContactResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetContactResponse x -> GetContactResponse
$cfrom :: forall x. GetContactResponse -> Rep GetContactResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetContactResponse' 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:
--
-- 'displayName', 'getContactResponse_displayName' - The full name of the contact or escalation plan.
--
-- 'httpStatus', 'getContactResponse_httpStatus' - The response's http status code.
--
-- 'contactArn', 'getContactResponse_contactArn' - The ARN of the contact or escalation plan.
--
-- 'alias', 'getContactResponse_alias' - The alias of the contact or escalation plan. The alias is unique and
-- identifiable.
--
-- 'type'', 'getContactResponse_type' - The type of contact, either @PERSONAL@ or @ESCALATION@.
--
-- 'plan', 'getContactResponse_plan' - Details about the specific timing or stages and targets of the
-- escalation plan or engagement plan.
newGetContactResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'contactArn'
  Prelude.Text ->
  -- | 'alias'
  Prelude.Text ->
  -- | 'type''
  ContactType ->
  -- | 'plan'
  Plan ->
  GetContactResponse
newGetContactResponse :: Int -> Text -> Text -> ContactType -> Plan -> GetContactResponse
newGetContactResponse
  Int
pHttpStatus_
  Text
pContactArn_
  Text
pAlias_
  ContactType
pType_
  Plan
pPlan_ =
    GetContactResponse'
      { $sel:displayName:GetContactResponse' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetContactResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:contactArn:GetContactResponse' :: Text
contactArn = Text
pContactArn_,
        $sel:alias:GetContactResponse' :: Text
alias = Text
pAlias_,
        $sel:type':GetContactResponse' :: ContactType
type' = ContactType
pType_,
        $sel:plan:GetContactResponse' :: Plan
plan = Plan
pPlan_
      }

-- | The full name of the contact or escalation plan.
getContactResponse_displayName :: Lens.Lens' GetContactResponse (Prelude.Maybe Prelude.Text)
getContactResponse_displayName :: Lens' GetContactResponse (Maybe Text)
getContactResponse_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContactResponse' {Maybe Text
displayName :: Maybe Text
$sel:displayName:GetContactResponse' :: GetContactResponse -> Maybe Text
displayName} -> Maybe Text
displayName) (\s :: GetContactResponse
s@GetContactResponse' {} Maybe Text
a -> GetContactResponse
s {$sel:displayName:GetContactResponse' :: Maybe Text
displayName = Maybe Text
a} :: GetContactResponse)

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

-- | The ARN of the contact or escalation plan.
getContactResponse_contactArn :: Lens.Lens' GetContactResponse Prelude.Text
getContactResponse_contactArn :: Lens' GetContactResponse Text
getContactResponse_contactArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContactResponse' {Text
contactArn :: Text
$sel:contactArn:GetContactResponse' :: GetContactResponse -> Text
contactArn} -> Text
contactArn) (\s :: GetContactResponse
s@GetContactResponse' {} Text
a -> GetContactResponse
s {$sel:contactArn:GetContactResponse' :: Text
contactArn = Text
a} :: GetContactResponse)

-- | The alias of the contact or escalation plan. The alias is unique and
-- identifiable.
getContactResponse_alias :: Lens.Lens' GetContactResponse Prelude.Text
getContactResponse_alias :: Lens' GetContactResponse Text
getContactResponse_alias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContactResponse' {Text
alias :: Text
$sel:alias:GetContactResponse' :: GetContactResponse -> Text
alias} -> Text
alias) (\s :: GetContactResponse
s@GetContactResponse' {} Text
a -> GetContactResponse
s {$sel:alias:GetContactResponse' :: Text
alias = Text
a} :: GetContactResponse)

-- | The type of contact, either @PERSONAL@ or @ESCALATION@.
getContactResponse_type :: Lens.Lens' GetContactResponse ContactType
getContactResponse_type :: Lens' GetContactResponse ContactType
getContactResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContactResponse' {ContactType
type' :: ContactType
$sel:type':GetContactResponse' :: GetContactResponse -> ContactType
type'} -> ContactType
type') (\s :: GetContactResponse
s@GetContactResponse' {} ContactType
a -> GetContactResponse
s {$sel:type':GetContactResponse' :: ContactType
type' = ContactType
a} :: GetContactResponse)

-- | Details about the specific timing or stages and targets of the
-- escalation plan or engagement plan.
getContactResponse_plan :: Lens.Lens' GetContactResponse Plan
getContactResponse_plan :: Lens' GetContactResponse Plan
getContactResponse_plan = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContactResponse' {Plan
plan :: Plan
$sel:plan:GetContactResponse' :: GetContactResponse -> Plan
plan} -> Plan
plan) (\s :: GetContactResponse
s@GetContactResponse' {} Plan
a -> GetContactResponse
s {$sel:plan:GetContactResponse' :: Plan
plan = Plan
a} :: GetContactResponse)

instance Prelude.NFData GetContactResponse where
  rnf :: GetContactResponse -> ()
rnf GetContactResponse' {Int
Maybe Text
Text
ContactType
Plan
plan :: Plan
type' :: ContactType
alias :: Text
contactArn :: Text
httpStatus :: Int
displayName :: Maybe Text
$sel:plan:GetContactResponse' :: GetContactResponse -> Plan
$sel:type':GetContactResponse' :: GetContactResponse -> ContactType
$sel:alias:GetContactResponse' :: GetContactResponse -> Text
$sel:contactArn:GetContactResponse' :: GetContactResponse -> Text
$sel:httpStatus:GetContactResponse' :: GetContactResponse -> Int
$sel:displayName:GetContactResponse' :: GetContactResponse -> Maybe Text
..} =
    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 Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contactArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
alias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ContactType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Plan
plan