{-# 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.NetworkManager.GetCoreNetworkPolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns details about a core network policy. You can get details about
-- your current live policy or any previous policy version.
module Amazonka.NetworkManager.GetCoreNetworkPolicy
  ( -- * Creating a Request
    GetCoreNetworkPolicy (..),
    newGetCoreNetworkPolicy,

    -- * Request Lenses
    getCoreNetworkPolicy_alias,
    getCoreNetworkPolicy_policyVersionId,
    getCoreNetworkPolicy_coreNetworkId,

    -- * Destructuring the Response
    GetCoreNetworkPolicyResponse (..),
    newGetCoreNetworkPolicyResponse,

    -- * Response Lenses
    getCoreNetworkPolicyResponse_coreNetworkPolicy,
    getCoreNetworkPolicyResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.NetworkManager.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetCoreNetworkPolicy' smart constructor.
data GetCoreNetworkPolicy = GetCoreNetworkPolicy'
  { -- | The alias of a core network policy
    GetCoreNetworkPolicy -> Maybe CoreNetworkPolicyAlias
alias :: Prelude.Maybe CoreNetworkPolicyAlias,
    -- | The ID of a core network policy version.
    GetCoreNetworkPolicy -> Maybe Int
policyVersionId :: Prelude.Maybe Prelude.Int,
    -- | The ID of a core network.
    GetCoreNetworkPolicy -> Text
coreNetworkId :: Prelude.Text
  }
  deriving (GetCoreNetworkPolicy -> GetCoreNetworkPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCoreNetworkPolicy -> GetCoreNetworkPolicy -> Bool
$c/= :: GetCoreNetworkPolicy -> GetCoreNetworkPolicy -> Bool
== :: GetCoreNetworkPolicy -> GetCoreNetworkPolicy -> Bool
$c== :: GetCoreNetworkPolicy -> GetCoreNetworkPolicy -> Bool
Prelude.Eq, ReadPrec [GetCoreNetworkPolicy]
ReadPrec GetCoreNetworkPolicy
Int -> ReadS GetCoreNetworkPolicy
ReadS [GetCoreNetworkPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCoreNetworkPolicy]
$creadListPrec :: ReadPrec [GetCoreNetworkPolicy]
readPrec :: ReadPrec GetCoreNetworkPolicy
$creadPrec :: ReadPrec GetCoreNetworkPolicy
readList :: ReadS [GetCoreNetworkPolicy]
$creadList :: ReadS [GetCoreNetworkPolicy]
readsPrec :: Int -> ReadS GetCoreNetworkPolicy
$creadsPrec :: Int -> ReadS GetCoreNetworkPolicy
Prelude.Read, Int -> GetCoreNetworkPolicy -> ShowS
[GetCoreNetworkPolicy] -> ShowS
GetCoreNetworkPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCoreNetworkPolicy] -> ShowS
$cshowList :: [GetCoreNetworkPolicy] -> ShowS
show :: GetCoreNetworkPolicy -> String
$cshow :: GetCoreNetworkPolicy -> String
showsPrec :: Int -> GetCoreNetworkPolicy -> ShowS
$cshowsPrec :: Int -> GetCoreNetworkPolicy -> ShowS
Prelude.Show, forall x. Rep GetCoreNetworkPolicy x -> GetCoreNetworkPolicy
forall x. GetCoreNetworkPolicy -> Rep GetCoreNetworkPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCoreNetworkPolicy x -> GetCoreNetworkPolicy
$cfrom :: forall x. GetCoreNetworkPolicy -> Rep GetCoreNetworkPolicy x
Prelude.Generic)

-- |
-- Create a value of 'GetCoreNetworkPolicy' 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:
--
-- 'alias', 'getCoreNetworkPolicy_alias' - The alias of a core network policy
--
-- 'policyVersionId', 'getCoreNetworkPolicy_policyVersionId' - The ID of a core network policy version.
--
-- 'coreNetworkId', 'getCoreNetworkPolicy_coreNetworkId' - The ID of a core network.
newGetCoreNetworkPolicy ::
  -- | 'coreNetworkId'
  Prelude.Text ->
  GetCoreNetworkPolicy
newGetCoreNetworkPolicy :: Text -> GetCoreNetworkPolicy
newGetCoreNetworkPolicy Text
pCoreNetworkId_ =
  GetCoreNetworkPolicy'
    { $sel:alias:GetCoreNetworkPolicy' :: Maybe CoreNetworkPolicyAlias
alias = forall a. Maybe a
Prelude.Nothing,
      $sel:policyVersionId:GetCoreNetworkPolicy' :: Maybe Int
policyVersionId = forall a. Maybe a
Prelude.Nothing,
      $sel:coreNetworkId:GetCoreNetworkPolicy' :: Text
coreNetworkId = Text
pCoreNetworkId_
    }

-- | The alias of a core network policy
getCoreNetworkPolicy_alias :: Lens.Lens' GetCoreNetworkPolicy (Prelude.Maybe CoreNetworkPolicyAlias)
getCoreNetworkPolicy_alias :: Lens' GetCoreNetworkPolicy (Maybe CoreNetworkPolicyAlias)
getCoreNetworkPolicy_alias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreNetworkPolicy' {Maybe CoreNetworkPolicyAlias
alias :: Maybe CoreNetworkPolicyAlias
$sel:alias:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Maybe CoreNetworkPolicyAlias
alias} -> Maybe CoreNetworkPolicyAlias
alias) (\s :: GetCoreNetworkPolicy
s@GetCoreNetworkPolicy' {} Maybe CoreNetworkPolicyAlias
a -> GetCoreNetworkPolicy
s {$sel:alias:GetCoreNetworkPolicy' :: Maybe CoreNetworkPolicyAlias
alias = Maybe CoreNetworkPolicyAlias
a} :: GetCoreNetworkPolicy)

-- | The ID of a core network policy version.
getCoreNetworkPolicy_policyVersionId :: Lens.Lens' GetCoreNetworkPolicy (Prelude.Maybe Prelude.Int)
getCoreNetworkPolicy_policyVersionId :: Lens' GetCoreNetworkPolicy (Maybe Int)
getCoreNetworkPolicy_policyVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreNetworkPolicy' {Maybe Int
policyVersionId :: Maybe Int
$sel:policyVersionId:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Maybe Int
policyVersionId} -> Maybe Int
policyVersionId) (\s :: GetCoreNetworkPolicy
s@GetCoreNetworkPolicy' {} Maybe Int
a -> GetCoreNetworkPolicy
s {$sel:policyVersionId:GetCoreNetworkPolicy' :: Maybe Int
policyVersionId = Maybe Int
a} :: GetCoreNetworkPolicy)

-- | The ID of a core network.
getCoreNetworkPolicy_coreNetworkId :: Lens.Lens' GetCoreNetworkPolicy Prelude.Text
getCoreNetworkPolicy_coreNetworkId :: Lens' GetCoreNetworkPolicy Text
getCoreNetworkPolicy_coreNetworkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreNetworkPolicy' {Text
coreNetworkId :: Text
$sel:coreNetworkId:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Text
coreNetworkId} -> Text
coreNetworkId) (\s :: GetCoreNetworkPolicy
s@GetCoreNetworkPolicy' {} Text
a -> GetCoreNetworkPolicy
s {$sel:coreNetworkId:GetCoreNetworkPolicy' :: Text
coreNetworkId = Text
a} :: GetCoreNetworkPolicy)

instance Core.AWSRequest GetCoreNetworkPolicy where
  type
    AWSResponse GetCoreNetworkPolicy =
      GetCoreNetworkPolicyResponse
  request :: (Service -> Service)
-> GetCoreNetworkPolicy -> Request GetCoreNetworkPolicy
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 GetCoreNetworkPolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCoreNetworkPolicy)))
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 CoreNetworkPolicy -> Int -> GetCoreNetworkPolicyResponse
GetCoreNetworkPolicyResponse'
            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
"CoreNetworkPolicy")
            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 GetCoreNetworkPolicy where
  hashWithSalt :: Int -> GetCoreNetworkPolicy -> Int
hashWithSalt Int
_salt GetCoreNetworkPolicy' {Maybe Int
Maybe CoreNetworkPolicyAlias
Text
coreNetworkId :: Text
policyVersionId :: Maybe Int
alias :: Maybe CoreNetworkPolicyAlias
$sel:coreNetworkId:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Text
$sel:policyVersionId:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Maybe Int
$sel:alias:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Maybe CoreNetworkPolicyAlias
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CoreNetworkPolicyAlias
alias
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
policyVersionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
coreNetworkId

instance Prelude.NFData GetCoreNetworkPolicy where
  rnf :: GetCoreNetworkPolicy -> ()
rnf GetCoreNetworkPolicy' {Maybe Int
Maybe CoreNetworkPolicyAlias
Text
coreNetworkId :: Text
policyVersionId :: Maybe Int
alias :: Maybe CoreNetworkPolicyAlias
$sel:coreNetworkId:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Text
$sel:policyVersionId:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Maybe Int
$sel:alias:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Maybe CoreNetworkPolicyAlias
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CoreNetworkPolicyAlias
alias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
policyVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
coreNetworkId

instance Data.ToHeaders GetCoreNetworkPolicy where
  toHeaders :: GetCoreNetworkPolicy -> 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 GetCoreNetworkPolicy where
  toPath :: GetCoreNetworkPolicy -> ByteString
toPath GetCoreNetworkPolicy' {Maybe Int
Maybe CoreNetworkPolicyAlias
Text
coreNetworkId :: Text
policyVersionId :: Maybe Int
alias :: Maybe CoreNetworkPolicyAlias
$sel:coreNetworkId:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Text
$sel:policyVersionId:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Maybe Int
$sel:alias:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Maybe CoreNetworkPolicyAlias
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/core-networks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
coreNetworkId,
        ByteString
"/core-network-policy"
      ]

instance Data.ToQuery GetCoreNetworkPolicy where
  toQuery :: GetCoreNetworkPolicy -> QueryString
toQuery GetCoreNetworkPolicy' {Maybe Int
Maybe CoreNetworkPolicyAlias
Text
coreNetworkId :: Text
policyVersionId :: Maybe Int
alias :: Maybe CoreNetworkPolicyAlias
$sel:coreNetworkId:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Text
$sel:policyVersionId:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Maybe Int
$sel:alias:GetCoreNetworkPolicy' :: GetCoreNetworkPolicy -> Maybe CoreNetworkPolicyAlias
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"alias" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CoreNetworkPolicyAlias
alias,
        ByteString
"policyVersionId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
policyVersionId
      ]

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

-- |
-- Create a value of 'GetCoreNetworkPolicyResponse' 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:
--
-- 'coreNetworkPolicy', 'getCoreNetworkPolicyResponse_coreNetworkPolicy' - The details about a core network policy.
--
-- 'httpStatus', 'getCoreNetworkPolicyResponse_httpStatus' - The response's http status code.
newGetCoreNetworkPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCoreNetworkPolicyResponse
newGetCoreNetworkPolicyResponse :: Int -> GetCoreNetworkPolicyResponse
newGetCoreNetworkPolicyResponse Int
pHttpStatus_ =
  GetCoreNetworkPolicyResponse'
    { $sel:coreNetworkPolicy:GetCoreNetworkPolicyResponse' :: Maybe CoreNetworkPolicy
coreNetworkPolicy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCoreNetworkPolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The details about a core network policy.
getCoreNetworkPolicyResponse_coreNetworkPolicy :: Lens.Lens' GetCoreNetworkPolicyResponse (Prelude.Maybe CoreNetworkPolicy)
getCoreNetworkPolicyResponse_coreNetworkPolicy :: Lens' GetCoreNetworkPolicyResponse (Maybe CoreNetworkPolicy)
getCoreNetworkPolicyResponse_coreNetworkPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreNetworkPolicyResponse' {Maybe CoreNetworkPolicy
coreNetworkPolicy :: Maybe CoreNetworkPolicy
$sel:coreNetworkPolicy:GetCoreNetworkPolicyResponse' :: GetCoreNetworkPolicyResponse -> Maybe CoreNetworkPolicy
coreNetworkPolicy} -> Maybe CoreNetworkPolicy
coreNetworkPolicy) (\s :: GetCoreNetworkPolicyResponse
s@GetCoreNetworkPolicyResponse' {} Maybe CoreNetworkPolicy
a -> GetCoreNetworkPolicyResponse
s {$sel:coreNetworkPolicy:GetCoreNetworkPolicyResponse' :: Maybe CoreNetworkPolicy
coreNetworkPolicy = Maybe CoreNetworkPolicy
a} :: GetCoreNetworkPolicyResponse)

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

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