{-# 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.ConnectCases.GetDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about a specific domain if it exists.
module Amazonka.ConnectCases.GetDomain
  ( -- * Creating a Request
    GetDomain (..),
    newGetDomain,

    -- * Request Lenses
    getDomain_domainId,

    -- * Destructuring the Response
    GetDomainResponse (..),
    newGetDomainResponse,

    -- * Response Lenses
    getDomainResponse_tags,
    getDomainResponse_httpStatus,
    getDomainResponse_createdTime,
    getDomainResponse_domainArn,
    getDomainResponse_domainId,
    getDomainResponse_domainStatus,
    getDomainResponse_name,
  )
where

import Amazonka.ConnectCases.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:/ 'newGetDomain' smart constructor.
data GetDomain = GetDomain'
  { -- | The unique identifier of the Cases domain.
    GetDomain -> Text
domainId :: Prelude.Text
  }
  deriving (GetDomain -> GetDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDomain -> GetDomain -> Bool
$c/= :: GetDomain -> GetDomain -> Bool
== :: GetDomain -> GetDomain -> Bool
$c== :: GetDomain -> GetDomain -> Bool
Prelude.Eq, ReadPrec [GetDomain]
ReadPrec GetDomain
Int -> ReadS GetDomain
ReadS [GetDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDomain]
$creadListPrec :: ReadPrec [GetDomain]
readPrec :: ReadPrec GetDomain
$creadPrec :: ReadPrec GetDomain
readList :: ReadS [GetDomain]
$creadList :: ReadS [GetDomain]
readsPrec :: Int -> ReadS GetDomain
$creadsPrec :: Int -> ReadS GetDomain
Prelude.Read, Int -> GetDomain -> ShowS
[GetDomain] -> ShowS
GetDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDomain] -> ShowS
$cshowList :: [GetDomain] -> ShowS
show :: GetDomain -> String
$cshow :: GetDomain -> String
showsPrec :: Int -> GetDomain -> ShowS
$cshowsPrec :: Int -> GetDomain -> ShowS
Prelude.Show, forall x. Rep GetDomain x -> GetDomain
forall x. GetDomain -> Rep GetDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDomain x -> GetDomain
$cfrom :: forall x. GetDomain -> Rep GetDomain x
Prelude.Generic)

-- |
-- Create a value of 'GetDomain' 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:
--
-- 'domainId', 'getDomain_domainId' - The unique identifier of the Cases domain.
newGetDomain ::
  -- | 'domainId'
  Prelude.Text ->
  GetDomain
newGetDomain :: Text -> GetDomain
newGetDomain Text
pDomainId_ =
  GetDomain' {$sel:domainId:GetDomain' :: Text
domainId = Text
pDomainId_}

-- | The unique identifier of the Cases domain.
getDomain_domainId :: Lens.Lens' GetDomain Prelude.Text
getDomain_domainId :: Lens' GetDomain Text
getDomain_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomain' {Text
domainId :: Text
$sel:domainId:GetDomain' :: GetDomain -> Text
domainId} -> Text
domainId) (\s :: GetDomain
s@GetDomain' {} Text
a -> GetDomain
s {$sel:domainId:GetDomain' :: Text
domainId = Text
a} :: GetDomain)

instance Core.AWSRequest GetDomain where
  type AWSResponse GetDomain = GetDomainResponse
  request :: (Service -> Service) -> GetDomain -> Request GetDomain
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 GetDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDomain)))
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 (HashMap Text Text)
-> Int
-> ISO8601
-> Text
-> Text
-> DomainStatus
-> Text
-> GetDomainResponse
GetDomainResponse'
            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
"tags" 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))
            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
"createdTime")
            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
"domainArn")
            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
"domainId")
            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
"domainStatus")
            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
"name")
      )

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

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

instance Data.ToHeaders GetDomain where
  toHeaders :: GetDomain -> 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 GetDomain where
  toJSON :: GetDomain -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath GetDomain where
  toPath :: GetDomain -> ByteString
toPath GetDomain' {Text
domainId :: Text
$sel:domainId:GetDomain' :: GetDomain -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/domains/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainId]

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

-- | /See:/ 'newGetDomainResponse' smart constructor.
data GetDomainResponse = GetDomainResponse'
  { -- | A map of of key-value pairs that represent tags on a resource. Tags are
    -- used to organize, track, or control access for this resource.
    GetDomainResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetDomainResponse -> Int
httpStatus :: Prelude.Int,
    -- | The timestamp when the Cases domain was created.
    GetDomainResponse -> ISO8601
createdTime :: Data.ISO8601,
    -- | The Amazon Resource Name (ARN) for the Cases domain.
    GetDomainResponse -> Text
domainArn :: Prelude.Text,
    -- | The unique identifier of the Cases domain.
    GetDomainResponse -> Text
domainId :: Prelude.Text,
    -- | The status of the Cases domain.
    GetDomainResponse -> DomainStatus
domainStatus :: DomainStatus,
    -- | The name of the Cases domain.
    GetDomainResponse -> Text
name :: Prelude.Text
  }
  deriving (GetDomainResponse -> GetDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDomainResponse -> GetDomainResponse -> Bool
$c/= :: GetDomainResponse -> GetDomainResponse -> Bool
== :: GetDomainResponse -> GetDomainResponse -> Bool
$c== :: GetDomainResponse -> GetDomainResponse -> Bool
Prelude.Eq, ReadPrec [GetDomainResponse]
ReadPrec GetDomainResponse
Int -> ReadS GetDomainResponse
ReadS [GetDomainResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDomainResponse]
$creadListPrec :: ReadPrec [GetDomainResponse]
readPrec :: ReadPrec GetDomainResponse
$creadPrec :: ReadPrec GetDomainResponse
readList :: ReadS [GetDomainResponse]
$creadList :: ReadS [GetDomainResponse]
readsPrec :: Int -> ReadS GetDomainResponse
$creadsPrec :: Int -> ReadS GetDomainResponse
Prelude.Read, Int -> GetDomainResponse -> ShowS
[GetDomainResponse] -> ShowS
GetDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDomainResponse] -> ShowS
$cshowList :: [GetDomainResponse] -> ShowS
show :: GetDomainResponse -> String
$cshow :: GetDomainResponse -> String
showsPrec :: Int -> GetDomainResponse -> ShowS
$cshowsPrec :: Int -> GetDomainResponse -> ShowS
Prelude.Show, forall x. Rep GetDomainResponse x -> GetDomainResponse
forall x. GetDomainResponse -> Rep GetDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDomainResponse x -> GetDomainResponse
$cfrom :: forall x. GetDomainResponse -> Rep GetDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDomainResponse' 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:
--
-- 'tags', 'getDomainResponse_tags' - A map of of key-value pairs that represent tags on a resource. Tags are
-- used to organize, track, or control access for this resource.
--
-- 'httpStatus', 'getDomainResponse_httpStatus' - The response's http status code.
--
-- 'createdTime', 'getDomainResponse_createdTime' - The timestamp when the Cases domain was created.
--
-- 'domainArn', 'getDomainResponse_domainArn' - The Amazon Resource Name (ARN) for the Cases domain.
--
-- 'domainId', 'getDomainResponse_domainId' - The unique identifier of the Cases domain.
--
-- 'domainStatus', 'getDomainResponse_domainStatus' - The status of the Cases domain.
--
-- 'name', 'getDomainResponse_name' - The name of the Cases domain.
newGetDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'createdTime'
  Prelude.UTCTime ->
  -- | 'domainArn'
  Prelude.Text ->
  -- | 'domainId'
  Prelude.Text ->
  -- | 'domainStatus'
  DomainStatus ->
  -- | 'name'
  Prelude.Text ->
  GetDomainResponse
newGetDomainResponse :: Int
-> UTCTime
-> Text
-> Text
-> DomainStatus
-> Text
-> GetDomainResponse
newGetDomainResponse
  Int
pHttpStatus_
  UTCTime
pCreatedTime_
  Text
pDomainArn_
  Text
pDomainId_
  DomainStatus
pDomainStatus_
  Text
pName_ =
    GetDomainResponse'
      { $sel:tags:GetDomainResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetDomainResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:createdTime:GetDomainResponse' :: ISO8601
createdTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedTime_,
        $sel:domainArn:GetDomainResponse' :: Text
domainArn = Text
pDomainArn_,
        $sel:domainId:GetDomainResponse' :: Text
domainId = Text
pDomainId_,
        $sel:domainStatus:GetDomainResponse' :: DomainStatus
domainStatus = DomainStatus
pDomainStatus_,
        $sel:name:GetDomainResponse' :: Text
name = Text
pName_
      }

-- | A map of of key-value pairs that represent tags on a resource. Tags are
-- used to organize, track, or control access for this resource.
getDomainResponse_tags :: Lens.Lens' GetDomainResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getDomainResponse_tags :: Lens' GetDomainResponse (Maybe (HashMap Text Text))
getDomainResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetDomainResponse' :: GetDomainResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetDomainResponse
s@GetDomainResponse' {} Maybe (HashMap Text Text)
a -> GetDomainResponse
s {$sel:tags:GetDomainResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetDomainResponse) 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.
getDomainResponse_httpStatus :: Lens.Lens' GetDomainResponse Prelude.Int
getDomainResponse_httpStatus :: Lens' GetDomainResponse Int
getDomainResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetDomainResponse' :: GetDomainResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetDomainResponse
s@GetDomainResponse' {} Int
a -> GetDomainResponse
s {$sel:httpStatus:GetDomainResponse' :: Int
httpStatus = Int
a} :: GetDomainResponse)

-- | The timestamp when the Cases domain was created.
getDomainResponse_createdTime :: Lens.Lens' GetDomainResponse Prelude.UTCTime
getDomainResponse_createdTime :: Lens' GetDomainResponse UTCTime
getDomainResponse_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {ISO8601
createdTime :: ISO8601
$sel:createdTime:GetDomainResponse' :: GetDomainResponse -> ISO8601
createdTime} -> ISO8601
createdTime) (\s :: GetDomainResponse
s@GetDomainResponse' {} ISO8601
a -> GetDomainResponse
s {$sel:createdTime:GetDomainResponse' :: ISO8601
createdTime = ISO8601
a} :: GetDomainResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The Amazon Resource Name (ARN) for the Cases domain.
getDomainResponse_domainArn :: Lens.Lens' GetDomainResponse Prelude.Text
getDomainResponse_domainArn :: Lens' GetDomainResponse Text
getDomainResponse_domainArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Text
domainArn :: Text
$sel:domainArn:GetDomainResponse' :: GetDomainResponse -> Text
domainArn} -> Text
domainArn) (\s :: GetDomainResponse
s@GetDomainResponse' {} Text
a -> GetDomainResponse
s {$sel:domainArn:GetDomainResponse' :: Text
domainArn = Text
a} :: GetDomainResponse)

-- | The unique identifier of the Cases domain.
getDomainResponse_domainId :: Lens.Lens' GetDomainResponse Prelude.Text
getDomainResponse_domainId :: Lens' GetDomainResponse Text
getDomainResponse_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Text
domainId :: Text
$sel:domainId:GetDomainResponse' :: GetDomainResponse -> Text
domainId} -> Text
domainId) (\s :: GetDomainResponse
s@GetDomainResponse' {} Text
a -> GetDomainResponse
s {$sel:domainId:GetDomainResponse' :: Text
domainId = Text
a} :: GetDomainResponse)

-- | The status of the Cases domain.
getDomainResponse_domainStatus :: Lens.Lens' GetDomainResponse DomainStatus
getDomainResponse_domainStatus :: Lens' GetDomainResponse DomainStatus
getDomainResponse_domainStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {DomainStatus
domainStatus :: DomainStatus
$sel:domainStatus:GetDomainResponse' :: GetDomainResponse -> DomainStatus
domainStatus} -> DomainStatus
domainStatus) (\s :: GetDomainResponse
s@GetDomainResponse' {} DomainStatus
a -> GetDomainResponse
s {$sel:domainStatus:GetDomainResponse' :: DomainStatus
domainStatus = DomainStatus
a} :: GetDomainResponse)

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

instance Prelude.NFData GetDomainResponse where
  rnf :: GetDomainResponse -> ()
rnf GetDomainResponse' {Int
Maybe (HashMap Text Text)
Text
ISO8601
DomainStatus
name :: Text
domainStatus :: DomainStatus
domainId :: Text
domainArn :: Text
createdTime :: ISO8601
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
$sel:name:GetDomainResponse' :: GetDomainResponse -> Text
$sel:domainStatus:GetDomainResponse' :: GetDomainResponse -> DomainStatus
$sel:domainId:GetDomainResponse' :: GetDomainResponse -> Text
$sel:domainArn:GetDomainResponse' :: GetDomainResponse -> Text
$sel:createdTime:GetDomainResponse' :: GetDomainResponse -> ISO8601
$sel:httpStatus:GetDomainResponse' :: GetDomainResponse -> Int
$sel:tags:GetDomainResponse' :: GetDomainResponse -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      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 ISO8601
createdTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DomainStatus
domainStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name