{-# LANGUAGE GADTs #-}
module Cardano.CLI.Byron.Vote
( ByronVoteError(..)
, renderByronVoteError
, runVoteCreation
, submitByronVote
) where
import Cardano.Prelude
import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither)
import Control.Tracer (stdoutTracer, traceWith)
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as Text
import qualified Cardano.Binary as Binary
import Cardano.Chain.Update (AVote (..), Vote, mkVote, recoverUpId, recoverVoteId)
import Cardano.CLI.Byron.UpdateProposal (ByronUpdateProposalError,
deserialiseByronUpdateProposal, readByronUpdateProposal)
import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
import Ouroboros.Consensus.Byron.Ledger.Mempool (GenTx (..))
import Ouroboros.Consensus.Ledger.SupportsMempool (txId)
import Ouroboros.Consensus.Util.Condense (condense)
import Cardano.Api.Typed (NetworkId, toByronProtocolMagicId)
import Cardano.CLI.Byron.Genesis (ByronGenesisError)
import Cardano.CLI.Byron.Key (ByronKeyFailure, CardanoEra (..), readEraSigningKey)
import Cardano.CLI.Byron.Tx (ByronTxError, nodeSubmitTx)
import Cardano.CLI.Helpers (HelpersError, ensureNewFileLBS)
import Cardano.CLI.Types
data ByronVoteError
= ByronVoteDecodingError !Binary.DecoderError
| ByronVoteGenesisReadError !ByronGenesisError
| ByronVoteKeyReadFailure !ByronKeyFailure
| ByronVoteReadFileFailure !FilePath !Text
| ByronVoteTxSubmissionError !ByronTxError
| ByronVoteUpdateProposalFailure !ByronUpdateProposalError
| ByronVoteUpdateHelperError !HelpersError
deriving Int -> ByronVoteError -> ShowS
[ByronVoteError] -> ShowS
ByronVoteError -> String
(Int -> ByronVoteError -> ShowS)
-> (ByronVoteError -> String)
-> ([ByronVoteError] -> ShowS)
-> Show ByronVoteError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByronVoteError] -> ShowS
$cshowList :: [ByronVoteError] -> ShowS
show :: ByronVoteError -> String
$cshow :: ByronVoteError -> String
showsPrec :: Int -> ByronVoteError -> ShowS
$cshowsPrec :: Int -> ByronVoteError -> ShowS
Show
renderByronVoteError :: ByronVoteError -> Text
renderByronVoteError :: ByronVoteError -> Text
renderByronVoteError ByronVoteError
bVerr =
case ByronVoteError
bVerr of
ByronVoteDecodingError DecoderError
decoderErr -> Text
"Error decoding Byron vote: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (DecoderError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show DecoderError
decoderErr)
ByronVoteGenesisReadError ByronGenesisError
genErr -> Text
"Error reading the genesis file:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ByronGenesisError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ByronGenesisError
genErr)
ByronVoteReadFileFailure String
fp Text
err -> Text
"Error reading Byron vote at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
ByronVoteTxSubmissionError ByronTxError
txErr -> Text
"Error submitting the transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ByronTxError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ByronTxError
txErr)
ByronVoteUpdateProposalFailure ByronUpdateProposalError
err -> Text
"Error reading the update proposal: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ByronUpdateProposalError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ByronUpdateProposalError
err)
ByronVoteUpdateHelperError HelpersError
err ->Text
"Error creating the vote: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (HelpersError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HelpersError
err)
ByronVoteKeyReadFailure ByronKeyFailure
err -> Text
"Error reading the signing key: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ByronKeyFailure -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ByronKeyFailure
err)
runVoteCreation
:: NetworkId
-> SigningKeyFile
-> FilePath
-> Bool
-> FilePath
-> ExceptT ByronVoteError IO ()
runVoteCreation :: NetworkId
-> SigningKeyFile
-> String
-> Bool
-> String
-> ExceptT ByronVoteError IO ()
runVoteCreation NetworkId
nw SigningKeyFile
sKey String
upPropFp Bool
voteBool String
outputFp = do
SigningKey
sK <- (ByronKeyFailure -> ByronVoteError)
-> ExceptT ByronKeyFailure IO SigningKey
-> ExceptT ByronVoteError IO SigningKey
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronKeyFailure -> ByronVoteError
ByronVoteKeyReadFailure (ExceptT ByronKeyFailure IO SigningKey
-> ExceptT ByronVoteError IO SigningKey)
-> ExceptT ByronKeyFailure IO SigningKey
-> ExceptT ByronVoteError IO SigningKey
forall a b. (a -> b) -> a -> b
$ CardanoEra
-> SigningKeyFile -> ExceptT ByronKeyFailure IO SigningKey
readEraSigningKey CardanoEra
ByronEra SigningKeyFile
sKey
LByteString
upProp <- (ByronUpdateProposalError -> ByronVoteError)
-> ExceptT ByronUpdateProposalError IO LByteString
-> ExceptT ByronVoteError IO LByteString
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronUpdateProposalError -> ByronVoteError
ByronVoteUpdateProposalFailure (ExceptT ByronUpdateProposalError IO LByteString
-> ExceptT ByronVoteError IO LByteString)
-> ExceptT ByronUpdateProposalError IO LByteString
-> ExceptT ByronVoteError IO LByteString
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ByronUpdateProposalError IO LByteString
readByronUpdateProposal String
upPropFp
AProposal ByteString
proposal <- Either ByronVoteError (AProposal ByteString)
-> ExceptT ByronVoteError IO (AProposal ByteString)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ByronVoteError (AProposal ByteString)
-> ExceptT ByronVoteError IO (AProposal ByteString))
-> (Either ByronUpdateProposalError (AProposal ByteString)
-> Either ByronVoteError (AProposal ByteString))
-> Either ByronUpdateProposalError (AProposal ByteString)
-> ExceptT ByronVoteError IO (AProposal ByteString)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ByronUpdateProposalError -> ByronVoteError)
-> Either ByronUpdateProposalError (AProposal ByteString)
-> Either ByronVoteError (AProposal ByteString)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByronUpdateProposalError -> ByronVoteError
ByronVoteUpdateProposalFailure (Either ByronUpdateProposalError (AProposal ByteString)
-> ExceptT ByronVoteError IO (AProposal ByteString))
-> Either ByronUpdateProposalError (AProposal ByteString)
-> ExceptT ByronVoteError IO (AProposal ByteString)
forall a b. (a -> b) -> a -> b
$ LByteString
-> Either ByronUpdateProposalError (AProposal ByteString)
deserialiseByronUpdateProposal LByteString
upProp
let updatePropId :: UpId
updatePropId = AProposal ByteString -> UpId
recoverUpId AProposal ByteString
proposal
vote :: Vote
vote = ProtocolMagicId -> SigningKey -> UpId -> Bool -> Vote
mkVote (NetworkId -> ProtocolMagicId
toByronProtocolMagicId NetworkId
nw) SigningKey
sK UpId
updatePropId Bool
voteBool
(HelpersError -> ByronVoteError)
-> ExceptT HelpersError IO () -> ExceptT ByronVoteError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ByronVoteError
ByronVoteUpdateHelperError (ExceptT HelpersError IO () -> ExceptT ByronVoteError IO ())
-> ExceptT HelpersError IO () -> ExceptT ByronVoteError IO ()
forall a b. (a -> b) -> a -> b
$ String -> LByteString -> ExceptT HelpersError IO ()
ensureNewFileLBS String
outputFp (Vote -> LByteString
serialiseByronVote Vote
vote)
convertVoteToGenTx :: AVote ByteString -> GenTx ByronBlock
convertVoteToGenTx :: AVote ByteString -> GenTx ByronBlock
convertVoteToGenTx AVote ByteString
vote = VoteId -> AVote ByteString -> GenTx ByronBlock
ByronUpdateVote (AVote ByteString -> VoteId
recoverVoteId AVote ByteString
vote) AVote ByteString
vote
deserialiseByronVote :: LByteString -> Either ByronVoteError (AVote ByteString)
deserialiseByronVote :: LByteString -> Either ByronVoteError (AVote ByteString)
deserialiseByronVote LByteString
bs =
case LByteString -> Either DecoderError (AVote ByteSpan)
forall a. FromCBOR a => LByteString -> Either DecoderError a
Binary.decodeFull LByteString
bs of
Left DecoderError
deserFail -> ByronVoteError -> Either ByronVoteError (AVote ByteString)
forall a b. a -> Either a b
Left (ByronVoteError -> Either ByronVoteError (AVote ByteString))
-> ByronVoteError -> Either ByronVoteError (AVote ByteString)
forall a b. (a -> b) -> a -> b
$ DecoderError -> ByronVoteError
ByronVoteDecodingError DecoderError
deserFail
Right AVote ByteSpan
vote -> AVote ByteString -> Either ByronVoteError (AVote ByteString)
forall a b. b -> Either a b
Right (AVote ByteString -> Either ByronVoteError (AVote ByteString))
-> AVote ByteString -> Either ByronVoteError (AVote ByteString)
forall a b. (a -> b) -> a -> b
$ AVote ByteSpan -> AVote ByteString
annotateVote AVote ByteSpan
vote
where
annotateVote :: AVote Binary.ByteSpan -> AVote ByteString
annotateVote :: AVote ByteSpan -> AVote ByteString
annotateVote AVote ByteSpan
vote = LByteString -> AVote ByteSpan -> AVote ByteString
forall (f :: * -> *).
Functor f =>
LByteString -> f ByteSpan -> f ByteString
Binary.annotationBytes LByteString
bs AVote ByteSpan
vote
serialiseByronVote :: Vote -> LByteString
serialiseByronVote :: Vote -> LByteString
serialiseByronVote = Vote -> LByteString
forall a. ToCBOR a => a -> LByteString
Binary.serialize
submitByronVote
:: NetworkId
-> FilePath
-> ExceptT ByronVoteError IO ()
submitByronVote :: NetworkId -> String -> ExceptT ByronVoteError IO ()
submitByronVote NetworkId
network String
voteFp = do
LByteString
voteBs <- IO LByteString -> ExceptT ByronVoteError IO LByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LByteString -> ExceptT ByronVoteError IO LByteString)
-> IO LByteString -> ExceptT ByronVoteError IO LByteString
forall a b. (a -> b) -> a -> b
$ String -> IO LByteString
LB.readFile String
voteFp
AVote ByteString
vote <- Either ByronVoteError (AVote ByteString)
-> ExceptT ByronVoteError IO (AVote ByteString)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ByronVoteError (AVote ByteString)
-> ExceptT ByronVoteError IO (AVote ByteString))
-> Either ByronVoteError (AVote ByteString)
-> ExceptT ByronVoteError IO (AVote ByteString)
forall a b. (a -> b) -> a -> b
$ LByteString -> Either ByronVoteError (AVote ByteString)
deserialiseByronVote LByteString
voteBs
let genTx :: GenTx ByronBlock
genTx = AVote ByteString -> GenTx ByronBlock
convertVoteToGenTx AVote ByteString
vote
Tracer (ExceptT ByronVoteError IO) String
-> String -> ExceptT ByronVoteError IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer (ExceptT ByronVoteError IO) String
forall (m :: * -> *). MonadIO m => Tracer m String
stdoutTracer (String
"Vote TxId: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxId (GenTx ByronBlock) -> String
forall a. Condense a => a -> String
condense (GenTx ByronBlock -> TxId (GenTx ByronBlock)
forall tx. HasTxId tx => tx -> TxId tx
txId GenTx ByronBlock
genTx))
(ByronTxError -> ByronVoteError)
-> ExceptT ByronTxError IO () -> ExceptT ByronVoteError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronTxError -> ByronVoteError
ByronVoteTxSubmissionError (ExceptT ByronTxError IO () -> ExceptT ByronVoteError IO ())
-> ExceptT ByronTxError IO () -> ExceptT ByronVoteError IO ()
forall a b. (a -> b) -> a -> b
$ NetworkId -> GenTx ByronBlock -> ExceptT ByronTxError IO ()
nodeSubmitTx NetworkId
network GenTx ByronBlock
genTx