{-# 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.ManagedBlockChain.GetProposal
-- 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 detailed information about a proposal.
--
-- Applies only to Hyperledger Fabric.
module Amazonka.ManagedBlockChain.GetProposal
  ( -- * Creating a Request
    GetProposal (..),
    newGetProposal,

    -- * Request Lenses
    getProposal_networkId,
    getProposal_proposalId,

    -- * Destructuring the Response
    GetProposalResponse (..),
    newGetProposalResponse,

    -- * Response Lenses
    getProposalResponse_proposal,
    getProposalResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetProposal' smart constructor.
data GetProposal = GetProposal'
  { -- | The unique identifier of the network for which the proposal is made.
    GetProposal -> Text
networkId :: Prelude.Text,
    -- | The unique identifier of the proposal.
    GetProposal -> Text
proposalId :: Prelude.Text
  }
  deriving (GetProposal -> GetProposal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetProposal -> GetProposal -> Bool
$c/= :: GetProposal -> GetProposal -> Bool
== :: GetProposal -> GetProposal -> Bool
$c== :: GetProposal -> GetProposal -> Bool
Prelude.Eq, ReadPrec [GetProposal]
ReadPrec GetProposal
Int -> ReadS GetProposal
ReadS [GetProposal]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetProposal]
$creadListPrec :: ReadPrec [GetProposal]
readPrec :: ReadPrec GetProposal
$creadPrec :: ReadPrec GetProposal
readList :: ReadS [GetProposal]
$creadList :: ReadS [GetProposal]
readsPrec :: Int -> ReadS GetProposal
$creadsPrec :: Int -> ReadS GetProposal
Prelude.Read, Int -> GetProposal -> ShowS
[GetProposal] -> ShowS
GetProposal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProposal] -> ShowS
$cshowList :: [GetProposal] -> ShowS
show :: GetProposal -> String
$cshow :: GetProposal -> String
showsPrec :: Int -> GetProposal -> ShowS
$cshowsPrec :: Int -> GetProposal -> ShowS
Prelude.Show, forall x. Rep GetProposal x -> GetProposal
forall x. GetProposal -> Rep GetProposal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetProposal x -> GetProposal
$cfrom :: forall x. GetProposal -> Rep GetProposal x
Prelude.Generic)

-- |
-- Create a value of 'GetProposal' 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:
--
-- 'networkId', 'getProposal_networkId' - The unique identifier of the network for which the proposal is made.
--
-- 'proposalId', 'getProposal_proposalId' - The unique identifier of the proposal.
newGetProposal ::
  -- | 'networkId'
  Prelude.Text ->
  -- | 'proposalId'
  Prelude.Text ->
  GetProposal
newGetProposal :: Text -> Text -> GetProposal
newGetProposal Text
pNetworkId_ Text
pProposalId_ =
  GetProposal'
    { $sel:networkId:GetProposal' :: Text
networkId = Text
pNetworkId_,
      $sel:proposalId:GetProposal' :: Text
proposalId = Text
pProposalId_
    }

-- | The unique identifier of the network for which the proposal is made.
getProposal_networkId :: Lens.Lens' GetProposal Prelude.Text
getProposal_networkId :: Lens' GetProposal Text
getProposal_networkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProposal' {Text
networkId :: Text
$sel:networkId:GetProposal' :: GetProposal -> Text
networkId} -> Text
networkId) (\s :: GetProposal
s@GetProposal' {} Text
a -> GetProposal
s {$sel:networkId:GetProposal' :: Text
networkId = Text
a} :: GetProposal)

-- | The unique identifier of the proposal.
getProposal_proposalId :: Lens.Lens' GetProposal Prelude.Text
getProposal_proposalId :: Lens' GetProposal Text
getProposal_proposalId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProposal' {Text
proposalId :: Text
$sel:proposalId:GetProposal' :: GetProposal -> Text
proposalId} -> Text
proposalId) (\s :: GetProposal
s@GetProposal' {} Text
a -> GetProposal
s {$sel:proposalId:GetProposal' :: Text
proposalId = Text
a} :: GetProposal)

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

instance Prelude.NFData GetProposal where
  rnf :: GetProposal -> ()
rnf GetProposal' {Text
proposalId :: Text
networkId :: Text
$sel:proposalId:GetProposal' :: GetProposal -> Text
$sel:networkId:GetProposal' :: GetProposal -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
networkId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
proposalId

instance Data.ToHeaders GetProposal where
  toHeaders :: GetProposal -> 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 GetProposal where
  toPath :: GetProposal -> ByteString
toPath GetProposal' {Text
proposalId :: Text
networkId :: Text
$sel:proposalId:GetProposal' :: GetProposal -> Text
$sel:networkId:GetProposal' :: GetProposal -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/networks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
networkId,
        ByteString
"/proposals/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
proposalId
      ]

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

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

-- |
-- Create a value of 'GetProposalResponse' 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:
--
-- 'proposal', 'getProposalResponse_proposal' - Information about a proposal.
--
-- 'httpStatus', 'getProposalResponse_httpStatus' - The response's http status code.
newGetProposalResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetProposalResponse
newGetProposalResponse :: Int -> GetProposalResponse
newGetProposalResponse Int
pHttpStatus_ =
  GetProposalResponse'
    { $sel:proposal:GetProposalResponse' :: Maybe Proposal
proposal = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetProposalResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about a proposal.
getProposalResponse_proposal :: Lens.Lens' GetProposalResponse (Prelude.Maybe Proposal)
getProposalResponse_proposal :: Lens' GetProposalResponse (Maybe Proposal)
getProposalResponse_proposal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProposalResponse' {Maybe Proposal
proposal :: Maybe Proposal
$sel:proposal:GetProposalResponse' :: GetProposalResponse -> Maybe Proposal
proposal} -> Maybe Proposal
proposal) (\s :: GetProposalResponse
s@GetProposalResponse' {} Maybe Proposal
a -> GetProposalResponse
s {$sel:proposal:GetProposalResponse' :: Maybe Proposal
proposal = Maybe Proposal
a} :: GetProposalResponse)

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

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