{-# 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.PrivateNetworks.GetNetworkResource
-- 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 specified network resource.
module Amazonka.PrivateNetworks.GetNetworkResource
  ( -- * Creating a Request
    GetNetworkResource (..),
    newGetNetworkResource,

    -- * Request Lenses
    getNetworkResource_networkResourceArn,

    -- * Destructuring the Response
    GetNetworkResourceResponse (..),
    newGetNetworkResourceResponse,

    -- * Response Lenses
    getNetworkResourceResponse_tags,
    getNetworkResourceResponse_httpStatus,
    getNetworkResourceResponse_networkResource,
  )
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 Amazonka.PrivateNetworks.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetNetworkResource' smart constructor.
data GetNetworkResource = GetNetworkResource'
  { -- | The Amazon Resource Name (ARN) of the network resource.
    GetNetworkResource -> Text
networkResourceArn :: Prelude.Text
  }
  deriving (GetNetworkResource -> GetNetworkResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetNetworkResource -> GetNetworkResource -> Bool
$c/= :: GetNetworkResource -> GetNetworkResource -> Bool
== :: GetNetworkResource -> GetNetworkResource -> Bool
$c== :: GetNetworkResource -> GetNetworkResource -> Bool
Prelude.Eq, ReadPrec [GetNetworkResource]
ReadPrec GetNetworkResource
Int -> ReadS GetNetworkResource
ReadS [GetNetworkResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetNetworkResource]
$creadListPrec :: ReadPrec [GetNetworkResource]
readPrec :: ReadPrec GetNetworkResource
$creadPrec :: ReadPrec GetNetworkResource
readList :: ReadS [GetNetworkResource]
$creadList :: ReadS [GetNetworkResource]
readsPrec :: Int -> ReadS GetNetworkResource
$creadsPrec :: Int -> ReadS GetNetworkResource
Prelude.Read, Int -> GetNetworkResource -> ShowS
[GetNetworkResource] -> ShowS
GetNetworkResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetNetworkResource] -> ShowS
$cshowList :: [GetNetworkResource] -> ShowS
show :: GetNetworkResource -> String
$cshow :: GetNetworkResource -> String
showsPrec :: Int -> GetNetworkResource -> ShowS
$cshowsPrec :: Int -> GetNetworkResource -> ShowS
Prelude.Show, forall x. Rep GetNetworkResource x -> GetNetworkResource
forall x. GetNetworkResource -> Rep GetNetworkResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetNetworkResource x -> GetNetworkResource
$cfrom :: forall x. GetNetworkResource -> Rep GetNetworkResource x
Prelude.Generic)

-- |
-- Create a value of 'GetNetworkResource' 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:
--
-- 'networkResourceArn', 'getNetworkResource_networkResourceArn' - The Amazon Resource Name (ARN) of the network resource.
newGetNetworkResource ::
  -- | 'networkResourceArn'
  Prelude.Text ->
  GetNetworkResource
newGetNetworkResource :: Text -> GetNetworkResource
newGetNetworkResource Text
pNetworkResourceArn_ =
  GetNetworkResource'
    { $sel:networkResourceArn:GetNetworkResource' :: Text
networkResourceArn =
        Text
pNetworkResourceArn_
    }

-- | The Amazon Resource Name (ARN) of the network resource.
getNetworkResource_networkResourceArn :: Lens.Lens' GetNetworkResource Prelude.Text
getNetworkResource_networkResourceArn :: Lens' GetNetworkResource Text
getNetworkResource_networkResourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetNetworkResource' {Text
networkResourceArn :: Text
$sel:networkResourceArn:GetNetworkResource' :: GetNetworkResource -> Text
networkResourceArn} -> Text
networkResourceArn) (\s :: GetNetworkResource
s@GetNetworkResource' {} Text
a -> GetNetworkResource
s {$sel:networkResourceArn:GetNetworkResource' :: Text
networkResourceArn = Text
a} :: GetNetworkResource)

instance Core.AWSRequest GetNetworkResource where
  type
    AWSResponse GetNetworkResource =
      GetNetworkResourceResponse
  request :: (Service -> Service)
-> GetNetworkResource -> Request GetNetworkResource
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetNetworkResource
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetNetworkResource)))
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 (Sensitive (HashMap Text Text))
-> Int -> NetworkResource -> GetNetworkResourceResponse
GetNetworkResourceResponse'
            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
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"networkResource")
      )

instance Prelude.Hashable GetNetworkResource where
  hashWithSalt :: Int -> GetNetworkResource -> Int
hashWithSalt Int
_salt GetNetworkResource' {Text
networkResourceArn :: Text
$sel:networkResourceArn:GetNetworkResource' :: GetNetworkResource -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
networkResourceArn

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

instance Data.ToHeaders GetNetworkResource where
  toHeaders :: GetNetworkResource -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetNetworkResource where
  toPath :: GetNetworkResource -> ByteString
toPath GetNetworkResource' {Text
networkResourceArn :: Text
$sel:networkResourceArn:GetNetworkResource' :: GetNetworkResource -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/network-resources/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
networkResourceArn
      ]

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

-- | /See:/ 'newGetNetworkResourceResponse' smart constructor.
data GetNetworkResourceResponse = GetNetworkResourceResponse'
  { -- | The network resource tags.
    GetNetworkResourceResponse -> Maybe (Sensitive (HashMap Text Text))
tags :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | The response's http status code.
    GetNetworkResourceResponse -> Int
httpStatus :: Prelude.Int,
    -- | Information about the network resource.
    GetNetworkResourceResponse -> NetworkResource
networkResource :: NetworkResource
  }
  deriving (GetNetworkResourceResponse -> GetNetworkResourceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetNetworkResourceResponse -> GetNetworkResourceResponse -> Bool
$c/= :: GetNetworkResourceResponse -> GetNetworkResourceResponse -> Bool
== :: GetNetworkResourceResponse -> GetNetworkResourceResponse -> Bool
$c== :: GetNetworkResourceResponse -> GetNetworkResourceResponse -> Bool
Prelude.Eq, Int -> GetNetworkResourceResponse -> ShowS
[GetNetworkResourceResponse] -> ShowS
GetNetworkResourceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetNetworkResourceResponse] -> ShowS
$cshowList :: [GetNetworkResourceResponse] -> ShowS
show :: GetNetworkResourceResponse -> String
$cshow :: GetNetworkResourceResponse -> String
showsPrec :: Int -> GetNetworkResourceResponse -> ShowS
$cshowsPrec :: Int -> GetNetworkResourceResponse -> ShowS
Prelude.Show, forall x.
Rep GetNetworkResourceResponse x -> GetNetworkResourceResponse
forall x.
GetNetworkResourceResponse -> Rep GetNetworkResourceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetNetworkResourceResponse x -> GetNetworkResourceResponse
$cfrom :: forall x.
GetNetworkResourceResponse -> Rep GetNetworkResourceResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetNetworkResourceResponse' 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:
--
-- 'tags', 'getNetworkResourceResponse_tags' - The network resource tags.
--
-- 'httpStatus', 'getNetworkResourceResponse_httpStatus' - The response's http status code.
--
-- 'networkResource', 'getNetworkResourceResponse_networkResource' - Information about the network resource.
newGetNetworkResourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'networkResource'
  NetworkResource ->
  GetNetworkResourceResponse
newGetNetworkResourceResponse :: Int -> NetworkResource -> GetNetworkResourceResponse
newGetNetworkResourceResponse
  Int
pHttpStatus_
  NetworkResource
pNetworkResource_ =
    GetNetworkResourceResponse'
      { $sel:tags:GetNetworkResourceResponse' :: Maybe (Sensitive (HashMap Text Text))
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetNetworkResourceResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:networkResource:GetNetworkResourceResponse' :: NetworkResource
networkResource = NetworkResource
pNetworkResource_
      }

-- | The network resource tags.
getNetworkResourceResponse_tags :: Lens.Lens' GetNetworkResourceResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getNetworkResourceResponse_tags :: Lens' GetNetworkResourceResponse (Maybe (HashMap Text Text))
getNetworkResourceResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetNetworkResourceResponse' {Maybe (Sensitive (HashMap Text Text))
tags :: Maybe (Sensitive (HashMap Text Text))
$sel:tags:GetNetworkResourceResponse' :: GetNetworkResourceResponse -> Maybe (Sensitive (HashMap Text Text))
tags} -> Maybe (Sensitive (HashMap Text Text))
tags) (\s :: GetNetworkResourceResponse
s@GetNetworkResourceResponse' {} Maybe (Sensitive (HashMap Text Text))
a -> GetNetworkResourceResponse
s {$sel:tags:GetNetworkResourceResponse' :: Maybe (Sensitive (HashMap Text Text))
tags = Maybe (Sensitive (HashMap Text Text))
a} :: GetNetworkResourceResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

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

-- | Information about the network resource.
getNetworkResourceResponse_networkResource :: Lens.Lens' GetNetworkResourceResponse NetworkResource
getNetworkResourceResponse_networkResource :: Lens' GetNetworkResourceResponse NetworkResource
getNetworkResourceResponse_networkResource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetNetworkResourceResponse' {NetworkResource
networkResource :: NetworkResource
$sel:networkResource:GetNetworkResourceResponse' :: GetNetworkResourceResponse -> NetworkResource
networkResource} -> NetworkResource
networkResource) (\s :: GetNetworkResourceResponse
s@GetNetworkResourceResponse' {} NetworkResource
a -> GetNetworkResourceResponse
s {$sel:networkResource:GetNetworkResourceResponse' :: NetworkResource
networkResource = NetworkResource
a} :: GetNetworkResourceResponse)

instance Prelude.NFData GetNetworkResourceResponse where
  rnf :: GetNetworkResourceResponse -> ()
rnf GetNetworkResourceResponse' {Int
Maybe (Sensitive (HashMap Text Text))
NetworkResource
networkResource :: NetworkResource
httpStatus :: Int
tags :: Maybe (Sensitive (HashMap Text Text))
$sel:networkResource:GetNetworkResourceResponse' :: GetNetworkResourceResponse -> NetworkResource
$sel:httpStatus:GetNetworkResourceResponse' :: GetNetworkResourceResponse -> Int
$sel:tags:GetNetworkResourceResponse' :: GetNetworkResourceResponse -> Maybe (Sensitive (HashMap Text Text))
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NetworkResource
networkResource