{-# 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.ComprehendMedical.DescribePHIDetectionJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the properties associated with a protected health information (PHI)
-- detection job. Use this operation to get the status of a detection job.
module Amazonka.ComprehendMedical.DescribePHIDetectionJob
  ( -- * Creating a Request
    DescribePHIDetectionJob (..),
    newDescribePHIDetectionJob,

    -- * Request Lenses
    describePHIDetectionJob_jobId,

    -- * Destructuring the Response
    DescribePHIDetectionJobResponse (..),
    newDescribePHIDetectionJobResponse,

    -- * Response Lenses
    describePHIDetectionJobResponse_comprehendMedicalAsyncJobProperties,
    describePHIDetectionJobResponse_httpStatus,
  )
where

import Amazonka.ComprehendMedical.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:/ 'newDescribePHIDetectionJob' smart constructor.
data DescribePHIDetectionJob = DescribePHIDetectionJob'
  { -- | The identifier that Comprehend Medical; generated for the job. The
    -- @StartPHIDetectionJob@ operation returns this identifier in its
    -- response.
    DescribePHIDetectionJob -> Text
jobId :: Prelude.Text
  }
  deriving (DescribePHIDetectionJob -> DescribePHIDetectionJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePHIDetectionJob -> DescribePHIDetectionJob -> Bool
$c/= :: DescribePHIDetectionJob -> DescribePHIDetectionJob -> Bool
== :: DescribePHIDetectionJob -> DescribePHIDetectionJob -> Bool
$c== :: DescribePHIDetectionJob -> DescribePHIDetectionJob -> Bool
Prelude.Eq, ReadPrec [DescribePHIDetectionJob]
ReadPrec DescribePHIDetectionJob
Int -> ReadS DescribePHIDetectionJob
ReadS [DescribePHIDetectionJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePHIDetectionJob]
$creadListPrec :: ReadPrec [DescribePHIDetectionJob]
readPrec :: ReadPrec DescribePHIDetectionJob
$creadPrec :: ReadPrec DescribePHIDetectionJob
readList :: ReadS [DescribePHIDetectionJob]
$creadList :: ReadS [DescribePHIDetectionJob]
readsPrec :: Int -> ReadS DescribePHIDetectionJob
$creadsPrec :: Int -> ReadS DescribePHIDetectionJob
Prelude.Read, Int -> DescribePHIDetectionJob -> ShowS
[DescribePHIDetectionJob] -> ShowS
DescribePHIDetectionJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePHIDetectionJob] -> ShowS
$cshowList :: [DescribePHIDetectionJob] -> ShowS
show :: DescribePHIDetectionJob -> String
$cshow :: DescribePHIDetectionJob -> String
showsPrec :: Int -> DescribePHIDetectionJob -> ShowS
$cshowsPrec :: Int -> DescribePHIDetectionJob -> ShowS
Prelude.Show, forall x. Rep DescribePHIDetectionJob x -> DescribePHIDetectionJob
forall x. DescribePHIDetectionJob -> Rep DescribePHIDetectionJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribePHIDetectionJob x -> DescribePHIDetectionJob
$cfrom :: forall x. DescribePHIDetectionJob -> Rep DescribePHIDetectionJob x
Prelude.Generic)

-- |
-- Create a value of 'DescribePHIDetectionJob' 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:
--
-- 'jobId', 'describePHIDetectionJob_jobId' - The identifier that Comprehend Medical; generated for the job. The
-- @StartPHIDetectionJob@ operation returns this identifier in its
-- response.
newDescribePHIDetectionJob ::
  -- | 'jobId'
  Prelude.Text ->
  DescribePHIDetectionJob
newDescribePHIDetectionJob :: Text -> DescribePHIDetectionJob
newDescribePHIDetectionJob Text
pJobId_ =
  DescribePHIDetectionJob' {$sel:jobId:DescribePHIDetectionJob' :: Text
jobId = Text
pJobId_}

-- | The identifier that Comprehend Medical; generated for the job. The
-- @StartPHIDetectionJob@ operation returns this identifier in its
-- response.
describePHIDetectionJob_jobId :: Lens.Lens' DescribePHIDetectionJob Prelude.Text
describePHIDetectionJob_jobId :: Lens' DescribePHIDetectionJob Text
describePHIDetectionJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePHIDetectionJob' {Text
jobId :: Text
$sel:jobId:DescribePHIDetectionJob' :: DescribePHIDetectionJob -> Text
jobId} -> Text
jobId) (\s :: DescribePHIDetectionJob
s@DescribePHIDetectionJob' {} Text
a -> DescribePHIDetectionJob
s {$sel:jobId:DescribePHIDetectionJob' :: Text
jobId = Text
a} :: DescribePHIDetectionJob)

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

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

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

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

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

-- | /See:/ 'newDescribePHIDetectionJobResponse' smart constructor.
data DescribePHIDetectionJobResponse = DescribePHIDetectionJobResponse'
  { -- | An object that contains the properties associated with a detection job.
    DescribePHIDetectionJobResponse
-> Maybe ComprehendMedicalAsyncJobProperties
comprehendMedicalAsyncJobProperties :: Prelude.Maybe ComprehendMedicalAsyncJobProperties,
    -- | The response's http status code.
    DescribePHIDetectionJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribePHIDetectionJobResponse
-> DescribePHIDetectionJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePHIDetectionJobResponse
-> DescribePHIDetectionJobResponse -> Bool
$c/= :: DescribePHIDetectionJobResponse
-> DescribePHIDetectionJobResponse -> Bool
== :: DescribePHIDetectionJobResponse
-> DescribePHIDetectionJobResponse -> Bool
$c== :: DescribePHIDetectionJobResponse
-> DescribePHIDetectionJobResponse -> Bool
Prelude.Eq, ReadPrec [DescribePHIDetectionJobResponse]
ReadPrec DescribePHIDetectionJobResponse
Int -> ReadS DescribePHIDetectionJobResponse
ReadS [DescribePHIDetectionJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePHIDetectionJobResponse]
$creadListPrec :: ReadPrec [DescribePHIDetectionJobResponse]
readPrec :: ReadPrec DescribePHIDetectionJobResponse
$creadPrec :: ReadPrec DescribePHIDetectionJobResponse
readList :: ReadS [DescribePHIDetectionJobResponse]
$creadList :: ReadS [DescribePHIDetectionJobResponse]
readsPrec :: Int -> ReadS DescribePHIDetectionJobResponse
$creadsPrec :: Int -> ReadS DescribePHIDetectionJobResponse
Prelude.Read, Int -> DescribePHIDetectionJobResponse -> ShowS
[DescribePHIDetectionJobResponse] -> ShowS
DescribePHIDetectionJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePHIDetectionJobResponse] -> ShowS
$cshowList :: [DescribePHIDetectionJobResponse] -> ShowS
show :: DescribePHIDetectionJobResponse -> String
$cshow :: DescribePHIDetectionJobResponse -> String
showsPrec :: Int -> DescribePHIDetectionJobResponse -> ShowS
$cshowsPrec :: Int -> DescribePHIDetectionJobResponse -> ShowS
Prelude.Show, forall x.
Rep DescribePHIDetectionJobResponse x
-> DescribePHIDetectionJobResponse
forall x.
DescribePHIDetectionJobResponse
-> Rep DescribePHIDetectionJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribePHIDetectionJobResponse x
-> DescribePHIDetectionJobResponse
$cfrom :: forall x.
DescribePHIDetectionJobResponse
-> Rep DescribePHIDetectionJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribePHIDetectionJobResponse' 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:
--
-- 'comprehendMedicalAsyncJobProperties', 'describePHIDetectionJobResponse_comprehendMedicalAsyncJobProperties' - An object that contains the properties associated with a detection job.
--
-- 'httpStatus', 'describePHIDetectionJobResponse_httpStatus' - The response's http status code.
newDescribePHIDetectionJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribePHIDetectionJobResponse
newDescribePHIDetectionJobResponse :: Int -> DescribePHIDetectionJobResponse
newDescribePHIDetectionJobResponse Int
pHttpStatus_ =
  DescribePHIDetectionJobResponse'
    { $sel:comprehendMedicalAsyncJobProperties:DescribePHIDetectionJobResponse' :: Maybe ComprehendMedicalAsyncJobProperties
comprehendMedicalAsyncJobProperties =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribePHIDetectionJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that contains the properties associated with a detection job.
describePHIDetectionJobResponse_comprehendMedicalAsyncJobProperties :: Lens.Lens' DescribePHIDetectionJobResponse (Prelude.Maybe ComprehendMedicalAsyncJobProperties)
describePHIDetectionJobResponse_comprehendMedicalAsyncJobProperties :: Lens'
  DescribePHIDetectionJobResponse
  (Maybe ComprehendMedicalAsyncJobProperties)
describePHIDetectionJobResponse_comprehendMedicalAsyncJobProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePHIDetectionJobResponse' {Maybe ComprehendMedicalAsyncJobProperties
comprehendMedicalAsyncJobProperties :: Maybe ComprehendMedicalAsyncJobProperties
$sel:comprehendMedicalAsyncJobProperties:DescribePHIDetectionJobResponse' :: DescribePHIDetectionJobResponse
-> Maybe ComprehendMedicalAsyncJobProperties
comprehendMedicalAsyncJobProperties} -> Maybe ComprehendMedicalAsyncJobProperties
comprehendMedicalAsyncJobProperties) (\s :: DescribePHIDetectionJobResponse
s@DescribePHIDetectionJobResponse' {} Maybe ComprehendMedicalAsyncJobProperties
a -> DescribePHIDetectionJobResponse
s {$sel:comprehendMedicalAsyncJobProperties:DescribePHIDetectionJobResponse' :: Maybe ComprehendMedicalAsyncJobProperties
comprehendMedicalAsyncJobProperties = Maybe ComprehendMedicalAsyncJobProperties
a} :: DescribePHIDetectionJobResponse)

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

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