{-# LANGUAGE GADTs #-}

module Bcc.CLI.Cole.Vote
  ( ColeVoteError(..)
  , readColeVote
  , renderColeVoteError
  , runVoteCreation
  , submitColeVote
  ) where

import           Bcc.Prelude

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


import qualified Bcc.Binary as Binary
import           Bcc.CLI.Cole.UpdateProposal (ColeUpdateProposalError,
                     readColeUpdateProposal)
import           Shardagnostic.Consensus.Ledger.SupportsMempool (txId)
import           Shardagnostic.Consensus.Util.Condense (condense)

import           Bcc.Api.Cole

import           Bcc.CLI.Cole.Genesis (ColeGenesisError)
import           Bcc.CLI.Cole.Key (ColeKeyFailure, readColeSigningKey)
import           Bcc.CLI.Cole.Tx (ColeTxError, nodeSubmitTx)
import           Bcc.CLI.Helpers (HelpersError, ensureNewFileLBS)
import           Bcc.CLI.Sophie.Commands (ColeKeyFormat (..))
import           Bcc.CLI.Types


data ColeVoteError
  = ColeVoteDecodingError !FilePath
  | ColeVoteGenesisReadError !ColeGenesisError
  | ColeVoteKeyReadFailure !ColeKeyFailure
  | ColeVoteReadFileFailure !FilePath !Text
  | ColeVoteTxSubmissionError !ColeTxError
  | ColeVoteUpdateProposalFailure !ColeUpdateProposalError
  | ColeVoteUpdateProposalDecodingError !Binary.DecoderError
  | ColeVoteUpdateHelperError !HelpersError
  deriving Int -> ColeVoteError -> ShowS
[ColeVoteError] -> ShowS
ColeVoteError -> String
(Int -> ColeVoteError -> ShowS)
-> (ColeVoteError -> String)
-> ([ColeVoteError] -> ShowS)
-> Show ColeVoteError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColeVoteError] -> ShowS
$cshowList :: [ColeVoteError] -> ShowS
show :: ColeVoteError -> String
$cshow :: ColeVoteError -> String
showsPrec :: Int -> ColeVoteError -> ShowS
$cshowsPrec :: Int -> ColeVoteError -> ShowS
Show

renderColeVoteError :: ColeVoteError -> Text
renderColeVoteError :: ColeVoteError -> Text
renderColeVoteError ColeVoteError
bVerr =
  case ColeVoteError
bVerr of
    ColeVoteDecodingError String
fp -> Text
"Error decoding Cole vote at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  String -> Text
Text.pack String
fp
    ColeVoteGenesisReadError ColeGenesisError
genErr -> Text
"Error reading the genesis file:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ColeGenesisError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ColeGenesisError
genErr)
    ColeVoteReadFileFailure String
fp Text
err -> Text
"Error reading Cole 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
    ColeVoteTxSubmissionError ColeTxError
txErr -> Text
"Error submitting the transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ColeTxError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ColeTxError
txErr)
    ColeVoteUpdateProposalDecodingError DecoderError
err -> Text
"Error decoding Cole update proposal: " 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
err)
    ColeVoteUpdateProposalFailure ColeUpdateProposalError
err -> Text
"Error reading the update proposal: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ColeUpdateProposalError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ColeUpdateProposalError
err)
    ColeVoteUpdateHelperError 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)
    ColeVoteKeyReadFailure ColeKeyFailure
err -> Text
"Error reading the signing key: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ColeKeyFailure -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ColeKeyFailure
err)


runVoteCreation
  :: NetworkId
  -> SigningKeyFile
  -> FilePath
  -> Bool
  -> FilePath
  -> ExceptT ColeVoteError IO ()
runVoteCreation :: NetworkId
-> SigningKeyFile
-> String
-> Bool
-> String
-> ExceptT ColeVoteError IO ()
runVoteCreation NetworkId
nw SigningKeyFile
sKey String
upPropFp Bool
voteBool String
outputFp = do
  SomeColeSigningKey
sK <- (ColeKeyFailure -> ColeVoteError)
-> ExceptT ColeKeyFailure IO SomeColeSigningKey
-> ExceptT ColeVoteError IO SomeColeSigningKey
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ColeKeyFailure -> ColeVoteError
ColeVoteKeyReadFailure (ExceptT ColeKeyFailure IO SomeColeSigningKey
 -> ExceptT ColeVoteError IO SomeColeSigningKey)
-> ExceptT ColeKeyFailure IO SomeColeSigningKey
-> ExceptT ColeVoteError IO SomeColeSigningKey
forall a b. (a -> b) -> a -> b
$ ColeKeyFormat
-> SigningKeyFile -> ExceptT ColeKeyFailure IO SomeColeSigningKey
readColeSigningKey ColeKeyFormat
NonLegacyColeKeyFormat SigningKeyFile
sKey
  ColeUpdateProposal
proposal <- (ColeUpdateProposalError -> ColeVoteError)
-> ExceptT ColeUpdateProposalError IO ColeUpdateProposal
-> ExceptT ColeVoteError IO ColeUpdateProposal
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ColeUpdateProposalError -> ColeVoteError
ColeVoteUpdateProposalFailure (ExceptT ColeUpdateProposalError IO ColeUpdateProposal
 -> ExceptT ColeVoteError IO ColeUpdateProposal)
-> ExceptT ColeUpdateProposalError IO ColeUpdateProposal
-> ExceptT ColeVoteError IO ColeUpdateProposal
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ColeUpdateProposalError IO ColeUpdateProposal
readColeUpdateProposal String
upPropFp
  let vote :: ColeVote
vote = NetworkId
-> SomeColeSigningKey -> ColeUpdateProposal -> Bool -> ColeVote
makeColeVote NetworkId
nw SomeColeSigningKey
sK ColeUpdateProposal
proposal Bool
voteBool
  (HelpersError -> ColeVoteError)
-> ExceptT HelpersError IO () -> ExceptT ColeVoteError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ColeVoteError
ColeVoteUpdateHelperError (ExceptT HelpersError IO () -> ExceptT ColeVoteError IO ())
-> (ByteString -> ExceptT HelpersError IO ())
-> ByteString
-> ExceptT ColeVoteError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString -> ExceptT HelpersError IO ()
ensureNewFileLBS String
outputFp
    (ByteString -> ExceptT ColeVoteError IO ())
-> ByteString -> ExceptT ColeVoteError IO ()
forall a b. (a -> b) -> a -> b
$ ColeVote -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes ColeVote
vote

submitColeVote
  :: NetworkId
  -> FilePath
  -> ExceptT ColeVoteError IO ()
submitColeVote :: NetworkId -> String -> ExceptT ColeVoteError IO ()
submitColeVote NetworkId
network String
voteFp = do
    ColeVote
vote <- String -> ExceptT ColeVoteError IO ColeVote
readColeVote String
voteFp
    let genTx :: GenTx ColeBlock
genTx = ColeVote -> GenTx ColeBlock
toColeLedgertoColeVote ColeVote
vote
    Tracer (ExceptT ColeVoteError IO) String
-> String -> ExceptT ColeVoteError IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer (ExceptT ColeVoteError IO) String
forall (m :: * -> *). MonadIO m => Tracer m String
stdoutTracer (String
"Vote TxId: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxId (GenTx ColeBlock) -> String
forall a. Condense a => a -> String
condense (GenTx ColeBlock -> TxId (GenTx ColeBlock)
forall tx. HasTxId tx => tx -> TxId tx
txId GenTx ColeBlock
genTx))
    (ColeTxError -> ColeVoteError)
-> ExceptT ColeTxError IO () -> ExceptT ColeVoteError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ColeTxError -> ColeVoteError
ColeVoteTxSubmissionError (ExceptT ColeTxError IO () -> ExceptT ColeVoteError IO ())
-> ExceptT ColeTxError IO () -> ExceptT ColeVoteError IO ()
forall a b. (a -> b) -> a -> b
$ NetworkId -> GenTx ColeBlock -> ExceptT ColeTxError IO ()
nodeSubmitTx NetworkId
network GenTx ColeBlock
genTx

readColeVote :: FilePath -> ExceptT ColeVoteError IO ColeVote
readColeVote :: String -> ExceptT ColeVoteError IO ColeVote
readColeVote String
fp = do
  ByteString
voteBs <- IO ByteString -> ExceptT ColeVoteError IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ExceptT ColeVoteError IO ByteString)
-> IO ByteString -> ExceptT ColeVoteError IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
fp
  let mVote :: Maybe ColeVote
mVote = AsType ColeVote -> ByteString -> Maybe ColeVote
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes AsType ColeVote
AsColeVote ByteString
voteBs
  Either ColeVoteError ColeVote -> ExceptT ColeVoteError IO ColeVote
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ColeVoteError ColeVote
 -> ExceptT ColeVoteError IO ColeVote)
-> Either ColeVoteError ColeVote
-> ExceptT ColeVoteError IO ColeVote
forall a b. (a -> b) -> a -> b
$ Either ColeVoteError ColeVote
-> (ColeVote -> Either ColeVoteError ColeVote)
-> Maybe ColeVote
-> Either ColeVoteError ColeVote
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ColeVoteError -> Either ColeVoteError ColeVote
forall a b. a -> Either a b
Left (ColeVoteError -> Either ColeVoteError ColeVote)
-> ColeVoteError -> Either ColeVoteError ColeVote
forall a b. (a -> b) -> a -> b
$ String -> ColeVoteError
ColeVoteDecodingError String
fp) ColeVote -> Either ColeVoteError ColeVote
forall a b. b -> Either a b
Right Maybe ColeVote
mVote