{-# 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.XRay.GetInsight
-- 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 the summary information of an insight. This includes impact to
-- clients and root cause services, the top anomalous services, the
-- category, the state of the insight, and the start and end time of the
-- insight.
module Amazonka.XRay.GetInsight
  ( -- * Creating a Request
    GetInsight (..),
    newGetInsight,

    -- * Request Lenses
    getInsight_insightId,

    -- * Destructuring the Response
    GetInsightResponse (..),
    newGetInsightResponse,

    -- * Response Lenses
    getInsightResponse_insight,
    getInsightResponse_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.XRay.Types

-- | /See:/ 'newGetInsight' smart constructor.
data GetInsight = GetInsight'
  { -- | The insight\'s unique identifier. Use the GetInsightSummaries action to
    -- retrieve an InsightId.
    GetInsight -> Text
insightId :: Prelude.Text
  }
  deriving (GetInsight -> GetInsight -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetInsight -> GetInsight -> Bool
$c/= :: GetInsight -> GetInsight -> Bool
== :: GetInsight -> GetInsight -> Bool
$c== :: GetInsight -> GetInsight -> Bool
Prelude.Eq, ReadPrec [GetInsight]
ReadPrec GetInsight
Int -> ReadS GetInsight
ReadS [GetInsight]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetInsight]
$creadListPrec :: ReadPrec [GetInsight]
readPrec :: ReadPrec GetInsight
$creadPrec :: ReadPrec GetInsight
readList :: ReadS [GetInsight]
$creadList :: ReadS [GetInsight]
readsPrec :: Int -> ReadS GetInsight
$creadsPrec :: Int -> ReadS GetInsight
Prelude.Read, Int -> GetInsight -> ShowS
[GetInsight] -> ShowS
GetInsight -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetInsight] -> ShowS
$cshowList :: [GetInsight] -> ShowS
show :: GetInsight -> String
$cshow :: GetInsight -> String
showsPrec :: Int -> GetInsight -> ShowS
$cshowsPrec :: Int -> GetInsight -> ShowS
Prelude.Show, forall x. Rep GetInsight x -> GetInsight
forall x. GetInsight -> Rep GetInsight x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetInsight x -> GetInsight
$cfrom :: forall x. GetInsight -> Rep GetInsight x
Prelude.Generic)

-- |
-- Create a value of 'GetInsight' 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:
--
-- 'insightId', 'getInsight_insightId' - The insight\'s unique identifier. Use the GetInsightSummaries action to
-- retrieve an InsightId.
newGetInsight ::
  -- | 'insightId'
  Prelude.Text ->
  GetInsight
newGetInsight :: Text -> GetInsight
newGetInsight Text
pInsightId_ =
  GetInsight' {$sel:insightId:GetInsight' :: Text
insightId = Text
pInsightId_}

-- | The insight\'s unique identifier. Use the GetInsightSummaries action to
-- retrieve an InsightId.
getInsight_insightId :: Lens.Lens' GetInsight Prelude.Text
getInsight_insightId :: Lens' GetInsight Text
getInsight_insightId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsight' {Text
insightId :: Text
$sel:insightId:GetInsight' :: GetInsight -> Text
insightId} -> Text
insightId) (\s :: GetInsight
s@GetInsight' {} Text
a -> GetInsight
s {$sel:insightId:GetInsight' :: Text
insightId = Text
a} :: GetInsight)

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

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

instance Data.ToHeaders GetInsight where
  toHeaders :: GetInsight -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON GetInsight where
  toJSON :: GetInsight -> Value
toJSON GetInsight' {Text
insightId :: Text
$sel:insightId:GetInsight' :: GetInsight -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"InsightId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
insightId)]
      )

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

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

-- | /See:/ 'newGetInsightResponse' smart constructor.
data GetInsightResponse = GetInsightResponse'
  { -- | The summary information of an insight.
    GetInsightResponse -> Maybe Insight
insight :: Prelude.Maybe Insight,
    -- | The response's http status code.
    GetInsightResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetInsightResponse -> GetInsightResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetInsightResponse -> GetInsightResponse -> Bool
$c/= :: GetInsightResponse -> GetInsightResponse -> Bool
== :: GetInsightResponse -> GetInsightResponse -> Bool
$c== :: GetInsightResponse -> GetInsightResponse -> Bool
Prelude.Eq, ReadPrec [GetInsightResponse]
ReadPrec GetInsightResponse
Int -> ReadS GetInsightResponse
ReadS [GetInsightResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetInsightResponse]
$creadListPrec :: ReadPrec [GetInsightResponse]
readPrec :: ReadPrec GetInsightResponse
$creadPrec :: ReadPrec GetInsightResponse
readList :: ReadS [GetInsightResponse]
$creadList :: ReadS [GetInsightResponse]
readsPrec :: Int -> ReadS GetInsightResponse
$creadsPrec :: Int -> ReadS GetInsightResponse
Prelude.Read, Int -> GetInsightResponse -> ShowS
[GetInsightResponse] -> ShowS
GetInsightResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetInsightResponse] -> ShowS
$cshowList :: [GetInsightResponse] -> ShowS
show :: GetInsightResponse -> String
$cshow :: GetInsightResponse -> String
showsPrec :: Int -> GetInsightResponse -> ShowS
$cshowsPrec :: Int -> GetInsightResponse -> ShowS
Prelude.Show, forall x. Rep GetInsightResponse x -> GetInsightResponse
forall x. GetInsightResponse -> Rep GetInsightResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetInsightResponse x -> GetInsightResponse
$cfrom :: forall x. GetInsightResponse -> Rep GetInsightResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetInsightResponse' 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:
--
-- 'insight', 'getInsightResponse_insight' - The summary information of an insight.
--
-- 'httpStatus', 'getInsightResponse_httpStatus' - The response's http status code.
newGetInsightResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetInsightResponse
newGetInsightResponse :: Int -> GetInsightResponse
newGetInsightResponse Int
pHttpStatus_ =
  GetInsightResponse'
    { $sel:insight:GetInsightResponse' :: Maybe Insight
insight = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetInsightResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The summary information of an insight.
getInsightResponse_insight :: Lens.Lens' GetInsightResponse (Prelude.Maybe Insight)
getInsightResponse_insight :: Lens' GetInsightResponse (Maybe Insight)
getInsightResponse_insight = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightResponse' {Maybe Insight
insight :: Maybe Insight
$sel:insight:GetInsightResponse' :: GetInsightResponse -> Maybe Insight
insight} -> Maybe Insight
insight) (\s :: GetInsightResponse
s@GetInsightResponse' {} Maybe Insight
a -> GetInsightResponse
s {$sel:insight:GetInsightResponse' :: Maybe Insight
insight = Maybe Insight
a} :: GetInsightResponse)

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

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