{-# 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.VoteOnProposal
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Casts a vote for a specified @ProposalId@ on behalf of a member. The
-- member to vote as, specified by @VoterMemberId@, must be in the same
-- Amazon Web Services account as the principal that calls the action.
--
-- Applies only to Hyperledger Fabric.
module Amazonka.ManagedBlockChain.VoteOnProposal
  ( -- * Creating a Request
    VoteOnProposal (..),
    newVoteOnProposal,

    -- * Request Lenses
    voteOnProposal_networkId,
    voteOnProposal_proposalId,
    voteOnProposal_voterMemberId,
    voteOnProposal_vote,

    -- * Destructuring the Response
    VoteOnProposalResponse (..),
    newVoteOnProposalResponse,

    -- * Response Lenses
    voteOnProposalResponse_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:/ 'newVoteOnProposal' smart constructor.
data VoteOnProposal = VoteOnProposal'
  { -- | The unique identifier of the network.
    VoteOnProposal -> Text
networkId :: Prelude.Text,
    -- | The unique identifier of the proposal.
    VoteOnProposal -> Text
proposalId :: Prelude.Text,
    -- | The unique identifier of the member casting the vote.
    VoteOnProposal -> Text
voterMemberId :: Prelude.Text,
    -- | The value of the vote.
    VoteOnProposal -> VoteValue
vote :: VoteValue
  }
  deriving (VoteOnProposal -> VoteOnProposal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VoteOnProposal -> VoteOnProposal -> Bool
$c/= :: VoteOnProposal -> VoteOnProposal -> Bool
== :: VoteOnProposal -> VoteOnProposal -> Bool
$c== :: VoteOnProposal -> VoteOnProposal -> Bool
Prelude.Eq, ReadPrec [VoteOnProposal]
ReadPrec VoteOnProposal
Int -> ReadS VoteOnProposal
ReadS [VoteOnProposal]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VoteOnProposal]
$creadListPrec :: ReadPrec [VoteOnProposal]
readPrec :: ReadPrec VoteOnProposal
$creadPrec :: ReadPrec VoteOnProposal
readList :: ReadS [VoteOnProposal]
$creadList :: ReadS [VoteOnProposal]
readsPrec :: Int -> ReadS VoteOnProposal
$creadsPrec :: Int -> ReadS VoteOnProposal
Prelude.Read, Int -> VoteOnProposal -> ShowS
[VoteOnProposal] -> ShowS
VoteOnProposal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VoteOnProposal] -> ShowS
$cshowList :: [VoteOnProposal] -> ShowS
show :: VoteOnProposal -> String
$cshow :: VoteOnProposal -> String
showsPrec :: Int -> VoteOnProposal -> ShowS
$cshowsPrec :: Int -> VoteOnProposal -> ShowS
Prelude.Show, forall x. Rep VoteOnProposal x -> VoteOnProposal
forall x. VoteOnProposal -> Rep VoteOnProposal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VoteOnProposal x -> VoteOnProposal
$cfrom :: forall x. VoteOnProposal -> Rep VoteOnProposal x
Prelude.Generic)

-- |
-- Create a value of 'VoteOnProposal' 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', 'voteOnProposal_networkId' - The unique identifier of the network.
--
-- 'proposalId', 'voteOnProposal_proposalId' - The unique identifier of the proposal.
--
-- 'voterMemberId', 'voteOnProposal_voterMemberId' - The unique identifier of the member casting the vote.
--
-- 'vote', 'voteOnProposal_vote' - The value of the vote.
newVoteOnProposal ::
  -- | 'networkId'
  Prelude.Text ->
  -- | 'proposalId'
  Prelude.Text ->
  -- | 'voterMemberId'
  Prelude.Text ->
  -- | 'vote'
  VoteValue ->
  VoteOnProposal
newVoteOnProposal :: Text -> Text -> Text -> VoteValue -> VoteOnProposal
newVoteOnProposal
  Text
pNetworkId_
  Text
pProposalId_
  Text
pVoterMemberId_
  VoteValue
pVote_ =
    VoteOnProposal'
      { $sel:networkId:VoteOnProposal' :: Text
networkId = Text
pNetworkId_,
        $sel:proposalId:VoteOnProposal' :: Text
proposalId = Text
pProposalId_,
        $sel:voterMemberId:VoteOnProposal' :: Text
voterMemberId = Text
pVoterMemberId_,
        $sel:vote:VoteOnProposal' :: VoteValue
vote = VoteValue
pVote_
      }

-- | The unique identifier of the network.
voteOnProposal_networkId :: Lens.Lens' VoteOnProposal Prelude.Text
voteOnProposal_networkId :: Lens' VoteOnProposal Text
voteOnProposal_networkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VoteOnProposal' {Text
networkId :: Text
$sel:networkId:VoteOnProposal' :: VoteOnProposal -> Text
networkId} -> Text
networkId) (\s :: VoteOnProposal
s@VoteOnProposal' {} Text
a -> VoteOnProposal
s {$sel:networkId:VoteOnProposal' :: Text
networkId = Text
a} :: VoteOnProposal)

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

-- | The unique identifier of the member casting the vote.
voteOnProposal_voterMemberId :: Lens.Lens' VoteOnProposal Prelude.Text
voteOnProposal_voterMemberId :: Lens' VoteOnProposal Text
voteOnProposal_voterMemberId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VoteOnProposal' {Text
voterMemberId :: Text
$sel:voterMemberId:VoteOnProposal' :: VoteOnProposal -> Text
voterMemberId} -> Text
voterMemberId) (\s :: VoteOnProposal
s@VoteOnProposal' {} Text
a -> VoteOnProposal
s {$sel:voterMemberId:VoteOnProposal' :: Text
voterMemberId = Text
a} :: VoteOnProposal)

-- | The value of the vote.
voteOnProposal_vote :: Lens.Lens' VoteOnProposal VoteValue
voteOnProposal_vote :: Lens' VoteOnProposal VoteValue
voteOnProposal_vote = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VoteOnProposal' {VoteValue
vote :: VoteValue
$sel:vote:VoteOnProposal' :: VoteOnProposal -> VoteValue
vote} -> VoteValue
vote) (\s :: VoteOnProposal
s@VoteOnProposal' {} VoteValue
a -> VoteOnProposal
s {$sel:vote:VoteOnProposal' :: VoteValue
vote = VoteValue
a} :: VoteOnProposal)

instance Core.AWSRequest VoteOnProposal where
  type
    AWSResponse VoteOnProposal =
      VoteOnProposalResponse
  request :: (Service -> Service) -> VoteOnProposal -> Request VoteOnProposal
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 VoteOnProposal
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse VoteOnProposal)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> VoteOnProposalResponse
VoteOnProposalResponse'
            forall (f :: * -> *) a b. Functor 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 VoteOnProposal where
  hashWithSalt :: Int -> VoteOnProposal -> Int
hashWithSalt Int
_salt VoteOnProposal' {Text
VoteValue
vote :: VoteValue
voterMemberId :: Text
proposalId :: Text
networkId :: Text
$sel:vote:VoteOnProposal' :: VoteOnProposal -> VoteValue
$sel:voterMemberId:VoteOnProposal' :: VoteOnProposal -> Text
$sel:proposalId:VoteOnProposal' :: VoteOnProposal -> Text
$sel:networkId:VoteOnProposal' :: VoteOnProposal -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
voterMemberId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VoteValue
vote

instance Prelude.NFData VoteOnProposal where
  rnf :: VoteOnProposal -> ()
rnf VoteOnProposal' {Text
VoteValue
vote :: VoteValue
voterMemberId :: Text
proposalId :: Text
networkId :: Text
$sel:vote:VoteOnProposal' :: VoteOnProposal -> VoteValue
$sel:voterMemberId:VoteOnProposal' :: VoteOnProposal -> Text
$sel:proposalId:VoteOnProposal' :: VoteOnProposal -> Text
$sel:networkId:VoteOnProposal' :: VoteOnProposal -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
voterMemberId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VoteValue
vote

instance Data.ToHeaders VoteOnProposal where
  toHeaders :: VoteOnProposal -> 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.ToJSON VoteOnProposal where
  toJSON :: VoteOnProposal -> Value
toJSON VoteOnProposal' {Text
VoteValue
vote :: VoteValue
voterMemberId :: Text
proposalId :: Text
networkId :: Text
$sel:vote:VoteOnProposal' :: VoteOnProposal -> VoteValue
$sel:voterMemberId:VoteOnProposal' :: VoteOnProposal -> Text
$sel:proposalId:VoteOnProposal' :: VoteOnProposal -> Text
$sel:networkId:VoteOnProposal' :: VoteOnProposal -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"VoterMemberId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
voterMemberId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Vote" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= VoteValue
vote)
          ]
      )

instance Data.ToPath VoteOnProposal where
  toPath :: VoteOnProposal -> ByteString
toPath VoteOnProposal' {Text
VoteValue
vote :: VoteValue
voterMemberId :: Text
proposalId :: Text
networkId :: Text
$sel:vote:VoteOnProposal' :: VoteOnProposal -> VoteValue
$sel:voterMemberId:VoteOnProposal' :: VoteOnProposal -> Text
$sel:proposalId:VoteOnProposal' :: VoteOnProposal -> Text
$sel:networkId:VoteOnProposal' :: VoteOnProposal -> 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,
        ByteString
"/votes"
      ]

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

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

-- |
-- Create a value of 'VoteOnProposalResponse' 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:
--
-- 'httpStatus', 'voteOnProposalResponse_httpStatus' - The response's http status code.
newVoteOnProposalResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  VoteOnProposalResponse
newVoteOnProposalResponse :: Int -> VoteOnProposalResponse
newVoteOnProposalResponse Int
pHttpStatus_ =
  VoteOnProposalResponse' {$sel:httpStatus:VoteOnProposalResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData VoteOnProposalResponse where
  rnf :: VoteOnProposalResponse -> ()
rnf VoteOnProposalResponse' {Int
httpStatus :: Int
$sel:httpStatus:VoteOnProposalResponse' :: VoteOnProposalResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus