{-# 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.Shield.DescribeProtection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the details of a Protection object.
module Amazonka.Shield.DescribeProtection
  ( -- * Creating a Request
    DescribeProtection (..),
    newDescribeProtection,

    -- * Request Lenses
    describeProtection_protectionId,
    describeProtection_resourceArn,

    -- * Destructuring the Response
    DescribeProtectionResponse (..),
    newDescribeProtectionResponse,

    -- * Response Lenses
    describeProtectionResponse_protection,
    describeProtectionResponse_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.Shield.Types

-- | /See:/ 'newDescribeProtection' smart constructor.
data DescribeProtection = DescribeProtection'
  { -- | The unique identifier (ID) for the Protection object to describe. You
    -- must provide either the @ResourceArn@ of the protected resource or the
    -- @ProtectionID@ of the protection, but not both.
    DescribeProtection -> Maybe Text
protectionId :: Prelude.Maybe Prelude.Text,
    -- | The ARN (Amazon Resource Name) of the protected Amazon Web Services
    -- resource. You must provide either the @ResourceArn@ of the protected
    -- resource or the @ProtectionID@ of the protection, but not both.
    DescribeProtection -> Maybe Text
resourceArn :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeProtection -> DescribeProtection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeProtection -> DescribeProtection -> Bool
$c/= :: DescribeProtection -> DescribeProtection -> Bool
== :: DescribeProtection -> DescribeProtection -> Bool
$c== :: DescribeProtection -> DescribeProtection -> Bool
Prelude.Eq, ReadPrec [DescribeProtection]
ReadPrec DescribeProtection
Int -> ReadS DescribeProtection
ReadS [DescribeProtection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeProtection]
$creadListPrec :: ReadPrec [DescribeProtection]
readPrec :: ReadPrec DescribeProtection
$creadPrec :: ReadPrec DescribeProtection
readList :: ReadS [DescribeProtection]
$creadList :: ReadS [DescribeProtection]
readsPrec :: Int -> ReadS DescribeProtection
$creadsPrec :: Int -> ReadS DescribeProtection
Prelude.Read, Int -> DescribeProtection -> ShowS
[DescribeProtection] -> ShowS
DescribeProtection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeProtection] -> ShowS
$cshowList :: [DescribeProtection] -> ShowS
show :: DescribeProtection -> String
$cshow :: DescribeProtection -> String
showsPrec :: Int -> DescribeProtection -> ShowS
$cshowsPrec :: Int -> DescribeProtection -> ShowS
Prelude.Show, forall x. Rep DescribeProtection x -> DescribeProtection
forall x. DescribeProtection -> Rep DescribeProtection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeProtection x -> DescribeProtection
$cfrom :: forall x. DescribeProtection -> Rep DescribeProtection x
Prelude.Generic)

-- |
-- Create a value of 'DescribeProtection' 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:
--
-- 'protectionId', 'describeProtection_protectionId' - The unique identifier (ID) for the Protection object to describe. You
-- must provide either the @ResourceArn@ of the protected resource or the
-- @ProtectionID@ of the protection, but not both.
--
-- 'resourceArn', 'describeProtection_resourceArn' - The ARN (Amazon Resource Name) of the protected Amazon Web Services
-- resource. You must provide either the @ResourceArn@ of the protected
-- resource or the @ProtectionID@ of the protection, but not both.
newDescribeProtection ::
  DescribeProtection
newDescribeProtection :: DescribeProtection
newDescribeProtection =
  DescribeProtection'
    { $sel:protectionId:DescribeProtection' :: Maybe Text
protectionId = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArn:DescribeProtection' :: Maybe Text
resourceArn = forall a. Maybe a
Prelude.Nothing
    }

-- | The unique identifier (ID) for the Protection object to describe. You
-- must provide either the @ResourceArn@ of the protected resource or the
-- @ProtectionID@ of the protection, but not both.
describeProtection_protectionId :: Lens.Lens' DescribeProtection (Prelude.Maybe Prelude.Text)
describeProtection_protectionId :: Lens' DescribeProtection (Maybe Text)
describeProtection_protectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProtection' {Maybe Text
protectionId :: Maybe Text
$sel:protectionId:DescribeProtection' :: DescribeProtection -> Maybe Text
protectionId} -> Maybe Text
protectionId) (\s :: DescribeProtection
s@DescribeProtection' {} Maybe Text
a -> DescribeProtection
s {$sel:protectionId:DescribeProtection' :: Maybe Text
protectionId = Maybe Text
a} :: DescribeProtection)

-- | The ARN (Amazon Resource Name) of the protected Amazon Web Services
-- resource. You must provide either the @ResourceArn@ of the protected
-- resource or the @ProtectionID@ of the protection, but not both.
describeProtection_resourceArn :: Lens.Lens' DescribeProtection (Prelude.Maybe Prelude.Text)
describeProtection_resourceArn :: Lens' DescribeProtection (Maybe Text)
describeProtection_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProtection' {Maybe Text
resourceArn :: Maybe Text
$sel:resourceArn:DescribeProtection' :: DescribeProtection -> Maybe Text
resourceArn} -> Maybe Text
resourceArn) (\s :: DescribeProtection
s@DescribeProtection' {} Maybe Text
a -> DescribeProtection
s {$sel:resourceArn:DescribeProtection' :: Maybe Text
resourceArn = Maybe Text
a} :: DescribeProtection)

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

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

instance Data.ToHeaders DescribeProtection where
  toHeaders :: DescribeProtection -> 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
"AWSShield_20160616.DescribeProtection" ::
                          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 DescribeProtection where
  toJSON :: DescribeProtection -> Value
toJSON DescribeProtection' {Maybe Text
resourceArn :: Maybe Text
protectionId :: Maybe Text
$sel:resourceArn:DescribeProtection' :: DescribeProtection -> Maybe Text
$sel:protectionId:DescribeProtection' :: DescribeProtection -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ProtectionId" 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
protectionId,
            (Key
"ResourceArn" 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
resourceArn
          ]
      )

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

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

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

-- |
-- Create a value of 'DescribeProtectionResponse' 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:
--
-- 'protection', 'describeProtectionResponse_protection' - The Protection that you requested.
--
-- 'httpStatus', 'describeProtectionResponse_httpStatus' - The response's http status code.
newDescribeProtectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeProtectionResponse
newDescribeProtectionResponse :: Int -> DescribeProtectionResponse
newDescribeProtectionResponse Int
pHttpStatus_ =
  DescribeProtectionResponse'
    { $sel:protection:DescribeProtectionResponse' :: Maybe Protection
protection =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeProtectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Protection that you requested.
describeProtectionResponse_protection :: Lens.Lens' DescribeProtectionResponse (Prelude.Maybe Protection)
describeProtectionResponse_protection :: Lens' DescribeProtectionResponse (Maybe Protection)
describeProtectionResponse_protection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProtectionResponse' {Maybe Protection
protection :: Maybe Protection
$sel:protection:DescribeProtectionResponse' :: DescribeProtectionResponse -> Maybe Protection
protection} -> Maybe Protection
protection) (\s :: DescribeProtectionResponse
s@DescribeProtectionResponse' {} Maybe Protection
a -> DescribeProtectionResponse
s {$sel:protection:DescribeProtectionResponse' :: Maybe Protection
protection = Maybe Protection
a} :: DescribeProtectionResponse)

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

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