{-# LANGUAGE GADTs #-}

module Cardano.CLI.Byron.Vote
  ( ByronVoteError(..)
  , readByronVote
  , renderByronVoteError
  , runVoteCreation
  , submitByronVote
  ) where

import           Control.Monad.Trans.Except (ExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither)
import           Control.Tracer (stdoutTracer, traceWith)
import qualified Data.ByteString as BS
import           Data.Text (Text)
import qualified Data.Text as Text

import qualified Cardano.Binary as Binary
import           Cardano.CLI.Byron.UpdateProposal (ByronUpdateProposalError,
                   readByronUpdateProposal)
import           Ouroboros.Consensus.Ledger.SupportsMempool (txId)
import           Ouroboros.Consensus.Util.Condense (condense)

import           Cardano.Api.Byron

import           Cardano.CLI.Byron.Genesis (ByronGenesisError)
import           Cardano.CLI.Byron.Key (ByronKeyFailure, readByronSigningKey)
import           Cardano.CLI.Byron.Tx (ByronTxError, nodeSubmitTx)
import           Cardano.CLI.Helpers (HelpersError, ensureNewFileLBS)
import           Cardano.CLI.Shelley.Commands (ByronKeyFormat (..))
import           Cardano.CLI.Types
import           Control.Monad.IO.Class (MonadIO (..))
import           Data.Bifunctor (first)


data ByronVoteError
  = ByronVoteDecodingError !FilePath
  | ByronVoteGenesisReadError !ByronGenesisError
  | ByronVoteKeyReadFailure !ByronKeyFailure
  | ByronVoteReadFileFailure !FilePath !Text
  | ByronVoteTxSubmissionError !ByronTxError
  | ByronVoteUpdateProposalFailure !ByronUpdateProposalError
  | ByronVoteUpdateProposalDecodingError !Binary.DecoderError
  | ByronVoteUpdateHelperError !HelpersError
  deriving Int -> ByronVoteError -> ShowS
[ByronVoteError] -> ShowS
ByronVoteError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ByronVoteError] -> ShowS
$cshowList :: [ByronVoteError] -> ShowS
show :: ByronVoteError -> [Char]
$cshow :: ByronVoteError -> [Char]
showsPrec :: Int -> ByronVoteError -> ShowS
$cshowsPrec :: Int -> ByronVoteError -> ShowS
Show

renderByronVoteError :: ByronVoteError -> Text
renderByronVoteError :: ByronVoteError -> Text
renderByronVoteError ByronVoteError
bVerr =
  case ByronVoteError
bVerr of
    ByronVoteDecodingError [Char]
fp -> Text
"Error decoding Byron vote at " forall a. Semigroup a => a -> a -> a
<>  [Char] -> Text
Text.pack [Char]
fp
    ByronVoteGenesisReadError ByronGenesisError
genErr -> Text
"Error reading the genesis file:" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show ByronGenesisError
genErr)
    ByronVoteReadFileFailure [Char]
fp Text
err -> Text
"Error reading Byron vote at " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
fp forall a. Semigroup a => a -> a -> a
<> Text
" Error: " forall a. Semigroup a => a -> a -> a
<> Text
err
    ByronVoteTxSubmissionError ByronTxError
txErr -> Text
"Error submitting the transaction: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show ByronTxError
txErr)
    ByronVoteUpdateProposalDecodingError DecoderError
err -> Text
"Error decoding Byron update proposal: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show DecoderError
err)
    ByronVoteUpdateProposalFailure ByronUpdateProposalError
err -> Text
"Error reading the update proposal: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show ByronUpdateProposalError
err)
    ByronVoteUpdateHelperError HelpersError
err ->Text
"Error creating the vote: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show HelpersError
err)
    ByronVoteKeyReadFailure ByronKeyFailure
err -> Text
"Error reading the signing key: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show ByronKeyFailure
err)


runVoteCreation
  :: NetworkId
  -> SigningKeyFile
  -> FilePath
  -> Bool
  -> FilePath
  -> ExceptT ByronVoteError IO ()
runVoteCreation :: NetworkId
-> SigningKeyFile
-> [Char]
-> Bool
-> [Char]
-> ExceptT ByronVoteError IO ()
runVoteCreation NetworkId
nw SigningKeyFile
sKey [Char]
upPropFp Bool
voteBool [Char]
outputFp = do
  SomeByronSigningKey
sK <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronKeyFailure -> ByronVoteError
ByronVoteKeyReadFailure forall a b. (a -> b) -> a -> b
$ ByronKeyFormat
-> SigningKeyFile -> ExceptT ByronKeyFailure IO SomeByronSigningKey
readByronSigningKey ByronKeyFormat
NonLegacyByronKeyFormat SigningKeyFile
sKey
  ByronUpdateProposal
proposal <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronUpdateProposalError -> ByronVoteError
ByronVoteUpdateProposalFailure forall a b. (a -> b) -> a -> b
$ [Char] -> ExceptT ByronUpdateProposalError IO ByronUpdateProposal
readByronUpdateProposal [Char]
upPropFp
  let vote :: ByronVote
vote = NetworkId
-> SomeByronSigningKey -> ByronUpdateProposal -> Bool -> ByronVote
makeByronVote NetworkId
nw SomeByronSigningKey
sK ByronUpdateProposal
proposal Bool
voteBool
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ByronVoteError
ByronVoteUpdateHelperError forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString -> ExceptT HelpersError IO ()
ensureNewFileLBS [Char]
outputFp
    forall a b. (a -> b) -> a -> b
$ forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes ByronVote
vote

submitByronVote
  :: NetworkId
  -> FilePath
  -> ExceptT ByronVoteError IO ()
submitByronVote :: NetworkId -> [Char] -> ExceptT ByronVoteError IO ()
submitByronVote NetworkId
network [Char]
voteFp = do
    ByronVote
vote <- [Char] -> ExceptT ByronVoteError IO ByronVote
readByronVote [Char]
voteFp
    let genTx :: GenTx ByronBlock
genTx = ByronVote -> GenTx ByronBlock
toByronLedgertoByronVote ByronVote
vote
    forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith forall (m :: * -> *). MonadIO m => Tracer m [Char]
stdoutTracer ([Char]
"Vote TxId: " forall a. [a] -> [a] -> [a]
++ forall a. Condense a => a -> [Char]
condense (forall tx. HasTxId tx => tx -> TxId tx
txId GenTx ByronBlock
genTx))
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronTxError -> ByronVoteError
ByronVoteTxSubmissionError forall a b. (a -> b) -> a -> b
$ NetworkId -> GenTx ByronBlock -> ExceptT ByronTxError IO ()
nodeSubmitTx NetworkId
network GenTx ByronBlock
genTx

readByronVote :: FilePath -> ExceptT ByronVoteError IO ByronVote
readByronVote :: [Char] -> ExceptT ByronVoteError IO ByronVote
readByronVote [Char]
fp = do
  ByteString
voteBs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
BS.readFile [Char]
fp
  let voteResult :: Either SerialiseAsRawBytesError ByronVote
voteResult = forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType ByronVote
AsByronVote ByteString
voteBs
  forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. a -> b -> a
const ([Char] -> ByronVoteError
ByronVoteDecodingError [Char]
fp)) Either SerialiseAsRawBytesError ByronVote
voteResult