{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}

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

import           Cardano.Api.Byron
import           Cardano.Api.Consensus (condense, txId)

import qualified Cardano.Binary as Binary
import           Cardano.CLI.Byron.Genesis (ByronGenesisError)
import           Cardano.CLI.Byron.Key (ByronKeyFailure, readByronSigningKey)
import           Cardano.CLI.Byron.Tx (ByronTxError, nodeSubmitTx)
import           Cardano.CLI.Byron.UpdateProposal (ByronUpdateProposalError,
                   readByronUpdateProposal)
import           Cardano.CLI.Helpers (HelpersError, ensureNewFileLBS)
import           Cardano.CLI.Types.Common

import           Control.Tracer (stdoutTracer, traceWith)
import           Data.Bifunctor (first)
import qualified Data.ByteString as BS
import           Data.Text (Text)

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]
(Int -> ByronVoteError -> ShowS)
-> (ByronVoteError -> [Char])
-> ([ByronVoteError] -> ShowS)
-> Show ByronVoteError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronVoteError -> ShowS
showsPrec :: Int -> ByronVoteError -> ShowS
$cshow :: ByronVoteError -> [Char]
show :: ByronVoteError -> [Char]
$cshowList :: [ByronVoteError] -> ShowS
showList :: [ByronVoteError] -> ShowS
Show

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

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

submitByronVote
  :: SocketPath
  -> NetworkId
  -> FilePath
  -> ExceptT ByronVoteError IO ()
submitByronVote :: SocketPath -> NetworkId -> [Char] -> ExceptT ByronVoteError IO ()
submitByronVote SocketPath
nodeSocketPath 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
  Tracer (ExceptT ByronVoteError IO) [Char]
-> [Char] -> ExceptT ByronVoteError IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer (ExceptT ByronVoteError IO) [Char]
forall (m :: * -> *). MonadIO m => Tracer m [Char]
stdoutTracer ([Char]
"Vote TxId: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ TxId (GenTx ByronBlock) -> [Char]
forall a. Condense a => a -> [Char]
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
$ SocketPath
-> NetworkId -> GenTx ByronBlock -> ExceptT ByronTxError IO ()
nodeSubmitTx SocketPath
nodeSocketPath NetworkId
network GenTx ByronBlock
genTx

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