{-# 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.SSM.GetOpsItem
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get information about an OpsItem by using the ID. You must have
-- permission in Identity and Access Management (IAM) to view information
-- about an OpsItem. For more information, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/OpsCenter-getting-started.html Getting started with OpsCenter>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- Operations engineers and IT professionals use Amazon Web Services
-- Systems Manager OpsCenter to view, investigate, and remediate
-- operational issues impacting the performance and health of their Amazon
-- Web Services resources. For more information, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/OpsCenter.html OpsCenter>
-- in the /Amazon Web Services Systems Manager User Guide/.
module Amazonka.SSM.GetOpsItem
  ( -- * Creating a Request
    GetOpsItem (..),
    newGetOpsItem,

    -- * Request Lenses
    getOpsItem_opsItemArn,
    getOpsItem_opsItemId,

    -- * Destructuring the Response
    GetOpsItemResponse (..),
    newGetOpsItemResponse,

    -- * Response Lenses
    getOpsItemResponse_opsItem,
    getOpsItemResponse_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.SSM.Types

-- | /See:/ 'newGetOpsItem' smart constructor.
data GetOpsItem = GetOpsItem'
  { -- | The OpsItem Amazon Resource Name (ARN).
    GetOpsItem -> Maybe Text
opsItemArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the OpsItem that you want to get.
    GetOpsItem -> Text
opsItemId :: Prelude.Text
  }
  deriving (GetOpsItem -> GetOpsItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetOpsItem -> GetOpsItem -> Bool
$c/= :: GetOpsItem -> GetOpsItem -> Bool
== :: GetOpsItem -> GetOpsItem -> Bool
$c== :: GetOpsItem -> GetOpsItem -> Bool
Prelude.Eq, ReadPrec [GetOpsItem]
ReadPrec GetOpsItem
Int -> ReadS GetOpsItem
ReadS [GetOpsItem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetOpsItem]
$creadListPrec :: ReadPrec [GetOpsItem]
readPrec :: ReadPrec GetOpsItem
$creadPrec :: ReadPrec GetOpsItem
readList :: ReadS [GetOpsItem]
$creadList :: ReadS [GetOpsItem]
readsPrec :: Int -> ReadS GetOpsItem
$creadsPrec :: Int -> ReadS GetOpsItem
Prelude.Read, Int -> GetOpsItem -> ShowS
[GetOpsItem] -> ShowS
GetOpsItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetOpsItem] -> ShowS
$cshowList :: [GetOpsItem] -> ShowS
show :: GetOpsItem -> String
$cshow :: GetOpsItem -> String
showsPrec :: Int -> GetOpsItem -> ShowS
$cshowsPrec :: Int -> GetOpsItem -> ShowS
Prelude.Show, forall x. Rep GetOpsItem x -> GetOpsItem
forall x. GetOpsItem -> Rep GetOpsItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetOpsItem x -> GetOpsItem
$cfrom :: forall x. GetOpsItem -> Rep GetOpsItem x
Prelude.Generic)

-- |
-- Create a value of 'GetOpsItem' 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:
--
-- 'opsItemArn', 'getOpsItem_opsItemArn' - The OpsItem Amazon Resource Name (ARN).
--
-- 'opsItemId', 'getOpsItem_opsItemId' - The ID of the OpsItem that you want to get.
newGetOpsItem ::
  -- | 'opsItemId'
  Prelude.Text ->
  GetOpsItem
newGetOpsItem :: Text -> GetOpsItem
newGetOpsItem Text
pOpsItemId_ =
  GetOpsItem'
    { $sel:opsItemArn:GetOpsItem' :: Maybe Text
opsItemArn = forall a. Maybe a
Prelude.Nothing,
      $sel:opsItemId:GetOpsItem' :: Text
opsItemId = Text
pOpsItemId_
    }

-- | The OpsItem Amazon Resource Name (ARN).
getOpsItem_opsItemArn :: Lens.Lens' GetOpsItem (Prelude.Maybe Prelude.Text)
getOpsItem_opsItemArn :: Lens' GetOpsItem (Maybe Text)
getOpsItem_opsItemArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOpsItem' {Maybe Text
opsItemArn :: Maybe Text
$sel:opsItemArn:GetOpsItem' :: GetOpsItem -> Maybe Text
opsItemArn} -> Maybe Text
opsItemArn) (\s :: GetOpsItem
s@GetOpsItem' {} Maybe Text
a -> GetOpsItem
s {$sel:opsItemArn:GetOpsItem' :: Maybe Text
opsItemArn = Maybe Text
a} :: GetOpsItem)

-- | The ID of the OpsItem that you want to get.
getOpsItem_opsItemId :: Lens.Lens' GetOpsItem Prelude.Text
getOpsItem_opsItemId :: Lens' GetOpsItem Text
getOpsItem_opsItemId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOpsItem' {Text
opsItemId :: Text
$sel:opsItemId:GetOpsItem' :: GetOpsItem -> Text
opsItemId} -> Text
opsItemId) (\s :: GetOpsItem
s@GetOpsItem' {} Text
a -> GetOpsItem
s {$sel:opsItemId:GetOpsItem' :: Text
opsItemId = Text
a} :: GetOpsItem)

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

instance Prelude.NFData GetOpsItem where
  rnf :: GetOpsItem -> ()
rnf GetOpsItem' {Maybe Text
Text
opsItemId :: Text
opsItemArn :: Maybe Text
$sel:opsItemId:GetOpsItem' :: GetOpsItem -> Text
$sel:opsItemArn:GetOpsItem' :: GetOpsItem -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
opsItemArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
opsItemId

instance Data.ToHeaders GetOpsItem where
  toHeaders :: GetOpsItem -> 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
"AmazonSSM.GetOpsItem" :: 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 GetOpsItem where
  toJSON :: GetOpsItem -> Value
toJSON GetOpsItem' {Maybe Text
Text
opsItemId :: Text
opsItemArn :: Maybe Text
$sel:opsItemId:GetOpsItem' :: GetOpsItem -> Text
$sel:opsItemArn:GetOpsItem' :: GetOpsItem -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"OpsItemArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
opsItemArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"OpsItemId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
opsItemId)
          ]
      )

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

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

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

-- |
-- Create a value of 'GetOpsItemResponse' 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:
--
-- 'opsItem', 'getOpsItemResponse_opsItem' - The OpsItem.
--
-- 'httpStatus', 'getOpsItemResponse_httpStatus' - The response's http status code.
newGetOpsItemResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetOpsItemResponse
newGetOpsItemResponse :: Int -> GetOpsItemResponse
newGetOpsItemResponse Int
pHttpStatus_ =
  GetOpsItemResponse'
    { $sel:opsItem:GetOpsItemResponse' :: Maybe OpsItem
opsItem = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetOpsItemResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The OpsItem.
getOpsItemResponse_opsItem :: Lens.Lens' GetOpsItemResponse (Prelude.Maybe OpsItem)
getOpsItemResponse_opsItem :: Lens' GetOpsItemResponse (Maybe OpsItem)
getOpsItemResponse_opsItem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOpsItemResponse' {Maybe OpsItem
opsItem :: Maybe OpsItem
$sel:opsItem:GetOpsItemResponse' :: GetOpsItemResponse -> Maybe OpsItem
opsItem} -> Maybe OpsItem
opsItem) (\s :: GetOpsItemResponse
s@GetOpsItemResponse' {} Maybe OpsItem
a -> GetOpsItemResponse
s {$sel:opsItem:GetOpsItemResponse' :: Maybe OpsItem
opsItem = Maybe OpsItem
a} :: GetOpsItemResponse)

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

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