{-# 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.VoiceId.DescribeFraudster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the specified fraudster.
module Amazonka.VoiceId.DescribeFraudster
  ( -- * Creating a Request
    DescribeFraudster (..),
    newDescribeFraudster,

    -- * Request Lenses
    describeFraudster_domainId,
    describeFraudster_fraudsterId,

    -- * Destructuring the Response
    DescribeFraudsterResponse (..),
    newDescribeFraudsterResponse,

    -- * Response Lenses
    describeFraudsterResponse_fraudster,
    describeFraudsterResponse_httpStatus,
  )
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.VoiceId.Types

-- | /See:/ 'newDescribeFraudster' smart constructor.
data DescribeFraudster = DescribeFraudster'
  { -- | The identifier of the domain containing the fraudster.
    DescribeFraudster -> Text
domainId :: Prelude.Text,
    -- | The identifier of the fraudster you are describing.
    DescribeFraudster -> Sensitive Text
fraudsterId :: Data.Sensitive Prelude.Text
  }
  deriving (DescribeFraudster -> DescribeFraudster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeFraudster -> DescribeFraudster -> Bool
$c/= :: DescribeFraudster -> DescribeFraudster -> Bool
== :: DescribeFraudster -> DescribeFraudster -> Bool
$c== :: DescribeFraudster -> DescribeFraudster -> Bool
Prelude.Eq, Int -> DescribeFraudster -> ShowS
[DescribeFraudster] -> ShowS
DescribeFraudster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeFraudster] -> ShowS
$cshowList :: [DescribeFraudster] -> ShowS
show :: DescribeFraudster -> String
$cshow :: DescribeFraudster -> String
showsPrec :: Int -> DescribeFraudster -> ShowS
$cshowsPrec :: Int -> DescribeFraudster -> ShowS
Prelude.Show, forall x. Rep DescribeFraudster x -> DescribeFraudster
forall x. DescribeFraudster -> Rep DescribeFraudster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeFraudster x -> DescribeFraudster
$cfrom :: forall x. DescribeFraudster -> Rep DescribeFraudster x
Prelude.Generic)

-- |
-- Create a value of 'DescribeFraudster' 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', 'describeFraudster_domainId' - The identifier of the domain containing the fraudster.
--
-- 'fraudsterId', 'describeFraudster_fraudsterId' - The identifier of the fraudster you are describing.
newDescribeFraudster ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'fraudsterId'
  Prelude.Text ->
  DescribeFraudster
newDescribeFraudster :: Text -> Text -> DescribeFraudster
newDescribeFraudster Text
pDomainId_ Text
pFraudsterId_ =
  DescribeFraudster'
    { $sel:domainId:DescribeFraudster' :: Text
domainId = Text
pDomainId_,
      $sel:fraudsterId:DescribeFraudster' :: Sensitive Text
fraudsterId = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pFraudsterId_
    }

-- | The identifier of the domain containing the fraudster.
describeFraudster_domainId :: Lens.Lens' DescribeFraudster Prelude.Text
describeFraudster_domainId :: Lens' DescribeFraudster Text
describeFraudster_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFraudster' {Text
domainId :: Text
$sel:domainId:DescribeFraudster' :: DescribeFraudster -> Text
domainId} -> Text
domainId) (\s :: DescribeFraudster
s@DescribeFraudster' {} Text
a -> DescribeFraudster
s {$sel:domainId:DescribeFraudster' :: Text
domainId = Text
a} :: DescribeFraudster)

-- | The identifier of the fraudster you are describing.
describeFraudster_fraudsterId :: Lens.Lens' DescribeFraudster Prelude.Text
describeFraudster_fraudsterId :: Lens' DescribeFraudster Text
describeFraudster_fraudsterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFraudster' {Sensitive Text
fraudsterId :: Sensitive Text
$sel:fraudsterId:DescribeFraudster' :: DescribeFraudster -> Sensitive Text
fraudsterId} -> Sensitive Text
fraudsterId) (\s :: DescribeFraudster
s@DescribeFraudster' {} Sensitive Text
a -> DescribeFraudster
s {$sel:fraudsterId:DescribeFraudster' :: Sensitive Text
fraudsterId = Sensitive Text
a} :: DescribeFraudster) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest DescribeFraudster where
  type
    AWSResponse DescribeFraudster =
      DescribeFraudsterResponse
  request :: (Service -> Service)
-> DescribeFraudster -> Request DescribeFraudster
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 DescribeFraudster
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeFraudster)))
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 Fraudster -> Int -> DescribeFraudsterResponse
DescribeFraudsterResponse'
            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
"Fraudster")
            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 DescribeFraudster where
  hashWithSalt :: Int -> DescribeFraudster -> Int
hashWithSalt Int
_salt DescribeFraudster' {Text
Sensitive Text
fraudsterId :: Sensitive Text
domainId :: Text
$sel:fraudsterId:DescribeFraudster' :: DescribeFraudster -> Sensitive Text
$sel:domainId:DescribeFraudster' :: DescribeFraudster -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
fraudsterId

instance Prelude.NFData DescribeFraudster where
  rnf :: DescribeFraudster -> ()
rnf DescribeFraudster' {Text
Sensitive Text
fraudsterId :: Sensitive Text
domainId :: Text
$sel:fraudsterId:DescribeFraudster' :: DescribeFraudster -> Sensitive Text
$sel:domainId:DescribeFraudster' :: DescribeFraudster -> Text
..} =
    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 Sensitive Text
fraudsterId

instance Data.ToHeaders DescribeFraudster where
  toHeaders :: DescribeFraudster -> 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
"VoiceID.DescribeFraudster" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DescribeFraudster where
  toJSON :: DescribeFraudster -> Value
toJSON DescribeFraudster' {Text
Sensitive Text
fraudsterId :: Sensitive Text
domainId :: Text
$sel:fraudsterId:DescribeFraudster' :: DescribeFraudster -> Sensitive Text
$sel:domainId:DescribeFraudster' :: DescribeFraudster -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"DomainId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainId),
            forall a. a -> Maybe a
Prelude.Just (Key
"FraudsterId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
fraudsterId)
          ]
      )

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

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

-- | /See:/ 'newDescribeFraudsterResponse' smart constructor.
data DescribeFraudsterResponse = DescribeFraudsterResponse'
  { -- | Information about the specified fraudster.
    DescribeFraudsterResponse -> Maybe Fraudster
fraudster :: Prelude.Maybe Fraudster,
    -- | The response's http status code.
    DescribeFraudsterResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeFraudsterResponse -> DescribeFraudsterResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeFraudsterResponse -> DescribeFraudsterResponse -> Bool
$c/= :: DescribeFraudsterResponse -> DescribeFraudsterResponse -> Bool
== :: DescribeFraudsterResponse -> DescribeFraudsterResponse -> Bool
$c== :: DescribeFraudsterResponse -> DescribeFraudsterResponse -> Bool
Prelude.Eq, ReadPrec [DescribeFraudsterResponse]
ReadPrec DescribeFraudsterResponse
Int -> ReadS DescribeFraudsterResponse
ReadS [DescribeFraudsterResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeFraudsterResponse]
$creadListPrec :: ReadPrec [DescribeFraudsterResponse]
readPrec :: ReadPrec DescribeFraudsterResponse
$creadPrec :: ReadPrec DescribeFraudsterResponse
readList :: ReadS [DescribeFraudsterResponse]
$creadList :: ReadS [DescribeFraudsterResponse]
readsPrec :: Int -> ReadS DescribeFraudsterResponse
$creadsPrec :: Int -> ReadS DescribeFraudsterResponse
Prelude.Read, Int -> DescribeFraudsterResponse -> ShowS
[DescribeFraudsterResponse] -> ShowS
DescribeFraudsterResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeFraudsterResponse] -> ShowS
$cshowList :: [DescribeFraudsterResponse] -> ShowS
show :: DescribeFraudsterResponse -> String
$cshow :: DescribeFraudsterResponse -> String
showsPrec :: Int -> DescribeFraudsterResponse -> ShowS
$cshowsPrec :: Int -> DescribeFraudsterResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeFraudsterResponse x -> DescribeFraudsterResponse
forall x.
DescribeFraudsterResponse -> Rep DescribeFraudsterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeFraudsterResponse x -> DescribeFraudsterResponse
$cfrom :: forall x.
DescribeFraudsterResponse -> Rep DescribeFraudsterResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeFraudsterResponse' 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:
--
-- 'fraudster', 'describeFraudsterResponse_fraudster' - Information about the specified fraudster.
--
-- 'httpStatus', 'describeFraudsterResponse_httpStatus' - The response's http status code.
newDescribeFraudsterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeFraudsterResponse
newDescribeFraudsterResponse :: Int -> DescribeFraudsterResponse
newDescribeFraudsterResponse Int
pHttpStatus_ =
  DescribeFraudsterResponse'
    { $sel:fraudster:DescribeFraudsterResponse' :: Maybe Fraudster
fraudster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeFraudsterResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the specified fraudster.
describeFraudsterResponse_fraudster :: Lens.Lens' DescribeFraudsterResponse (Prelude.Maybe Fraudster)
describeFraudsterResponse_fraudster :: Lens' DescribeFraudsterResponse (Maybe Fraudster)
describeFraudsterResponse_fraudster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFraudsterResponse' {Maybe Fraudster
fraudster :: Maybe Fraudster
$sel:fraudster:DescribeFraudsterResponse' :: DescribeFraudsterResponse -> Maybe Fraudster
fraudster} -> Maybe Fraudster
fraudster) (\s :: DescribeFraudsterResponse
s@DescribeFraudsterResponse' {} Maybe Fraudster
a -> DescribeFraudsterResponse
s {$sel:fraudster:DescribeFraudsterResponse' :: Maybe Fraudster
fraudster = Maybe Fraudster
a} :: DescribeFraudsterResponse)

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

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