{-# LANGUAGE GADTs #-}

module Bcc.CLI.Cole.UpdateProposal
  ( ColeUpdateProposalError(..)
  , runProposalCreation
  , readColeUpdateProposal
  , renderColeUpdateProposalError
  , submitColeUpdateProposal
  ) where

import           Bcc.Prelude

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

import           Bcc.Chain.Update (InstallerHash (..), ProtocolVersion (..),
                     SoftwareVersion (..), SystemTag (..))

import           Shardagnostic.Consensus.Ledger.SupportsMempool (txId)
import           Shardagnostic.Consensus.Util.Condense (condense)

import           Bcc.Api (NetworkId, SerialiseAsRawBytes (..))
import           Bcc.Api.Cole (AsType (AsColeUpdateProposal), ColeProtocolParametersUpdate,
                     ColeUpdateProposal, makeColeUpdateProposal, toColeLedgerUpdateProposal)

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, renderHelpersError, textShow)
import           Bcc.CLI.Sophie.Commands (ColeKeyFormat (..))
import           Bcc.CLI.Types

data ColeUpdateProposalError
  = ColeReadUpdateProposalFileFailure !FilePath !Text
  | ColeUpdateProposalWriteError !HelpersError
  | ColeUpdateProposalGenesisReadError !FilePath !ColeGenesisError
  | ColeUpdateProposalTxError !ColeTxError
  | ReadSigningKeyFailure !FilePath !ColeKeyFailure
  | UpdateProposalDecodingError !FilePath
  deriving Int -> ColeUpdateProposalError -> ShowS
[ColeUpdateProposalError] -> ShowS
ColeUpdateProposalError -> String
(Int -> ColeUpdateProposalError -> ShowS)
-> (ColeUpdateProposalError -> String)
-> ([ColeUpdateProposalError] -> ShowS)
-> Show ColeUpdateProposalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColeUpdateProposalError] -> ShowS
$cshowList :: [ColeUpdateProposalError] -> ShowS
show :: ColeUpdateProposalError -> String
$cshow :: ColeUpdateProposalError -> String
showsPrec :: Int -> ColeUpdateProposalError -> ShowS
$cshowsPrec :: Int -> ColeUpdateProposalError -> ShowS
Show

renderColeUpdateProposalError :: ColeUpdateProposalError -> Text
renderColeUpdateProposalError :: ColeUpdateProposalError -> Text
renderColeUpdateProposalError ColeUpdateProposalError
err =
  case ColeUpdateProposalError
err of
    ColeReadUpdateProposalFileFailure String
fp Text
rErr ->
      Text
"Error reading update proposal at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow 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 -> Text
forall a. Show a => a -> Text
textShow Text
rErr
    ColeUpdateProposalWriteError HelpersError
hErr ->
      Text
"Error writing update proposal: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HelpersError -> Text
renderHelpersError HelpersError
hErr
    ColeUpdateProposalGenesisReadError String
fp ColeGenesisError
rErr ->
      Text
"Error reading update proposal at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColeGenesisError -> Text
forall a. Show a => a -> Text
textShow ColeGenesisError
rErr
    ColeUpdateProposalTxError ColeTxError
txErr ->
      Text
"Error submitting update proposal: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColeTxError -> Text
forall a. Show a => a -> Text
textShow ColeTxError
txErr
    ReadSigningKeyFailure String
fp ColeKeyFailure
rErr ->
      Text
"Error reading signing key at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColeKeyFailure -> Text
forall a. Show a => a -> Text
textShow ColeKeyFailure
rErr
    UpdateProposalDecodingError String
fp ->
      Text
"Error decoding update proposal at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
fp

runProposalCreation
  :: NetworkId
  -> SigningKeyFile
  -> ProtocolVersion
  -> SoftwareVersion
  -> SystemTag
  -> InstallerHash
  -> FilePath
  -> ColeProtocolParametersUpdate
  -> ExceptT ColeUpdateProposalError IO ()
runProposalCreation :: NetworkId
-> SigningKeyFile
-> ProtocolVersion
-> SoftwareVersion
-> SystemTag
-> InstallerHash
-> String
-> ColeProtocolParametersUpdate
-> ExceptT ColeUpdateProposalError IO ()
runProposalCreation NetworkId
nw sKey :: SigningKeyFile
sKey@(SigningKeyFile String
sKeyfp) ProtocolVersion
pVer SoftwareVersion
sVer
                    SystemTag
sysTag InstallerHash
insHash String
outputFp ColeProtocolParametersUpdate
params = do
  SomeColeSigningKey
sK <- (ColeKeyFailure -> ColeUpdateProposalError)
-> ExceptT ColeKeyFailure IO SomeColeSigningKey
-> ExceptT ColeUpdateProposalError IO SomeColeSigningKey
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> ColeKeyFailure -> ColeUpdateProposalError
ReadSigningKeyFailure String
sKeyfp) (ExceptT ColeKeyFailure IO SomeColeSigningKey
 -> ExceptT ColeUpdateProposalError IO SomeColeSigningKey)
-> ExceptT ColeKeyFailure IO SomeColeSigningKey
-> ExceptT ColeUpdateProposalError IO SomeColeSigningKey
forall a b. (a -> b) -> a -> b
$ ColeKeyFormat
-> SigningKeyFile -> ExceptT ColeKeyFailure IO SomeColeSigningKey
readColeSigningKey ColeKeyFormat
NonLegacyColeKeyFormat SigningKeyFile
sKey
  let proposal :: ColeUpdateProposal
proposal = NetworkId
-> ProtocolVersion
-> SoftwareVersion
-> SystemTag
-> InstallerHash
-> SomeColeSigningKey
-> ColeProtocolParametersUpdate
-> ColeUpdateProposal
makeColeUpdateProposal NetworkId
nw ProtocolVersion
pVer SoftwareVersion
sVer SystemTag
sysTag InstallerHash
insHash SomeColeSigningKey
sK ColeProtocolParametersUpdate
params
  (HelpersError -> ColeUpdateProposalError)
-> ExceptT HelpersError IO ()
-> ExceptT ColeUpdateProposalError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ColeUpdateProposalError
ColeUpdateProposalWriteError (ExceptT HelpersError IO ()
 -> ExceptT ColeUpdateProposalError IO ())
-> ExceptT HelpersError IO ()
-> ExceptT ColeUpdateProposalError IO ()
forall a b. (a -> b) -> a -> b
$
    String -> ByteString -> ExceptT HelpersError IO ()
ensureNewFileLBS String
outputFp (ByteString -> ExceptT HelpersError IO ())
-> ByteString -> ExceptT HelpersError IO ()
forall a b. (a -> b) -> a -> b
$ ColeUpdateProposal -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes ColeUpdateProposal
proposal

readColeUpdateProposal :: FilePath -> ExceptT ColeUpdateProposalError IO ColeUpdateProposal
readColeUpdateProposal :: String -> ExceptT ColeUpdateProposalError IO ColeUpdateProposal
readColeUpdateProposal String
fp = do
  ByteString
proposalBs <- (IOException -> ColeUpdateProposalError)
-> IO ByteString -> ExceptT ColeUpdateProposalError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> Text -> ColeUpdateProposalError
ColeReadUpdateProposalFileFailure String
fp (Text -> ColeUpdateProposalError)
-> (IOException -> Text) -> IOException -> ColeUpdateProposalError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Text) -> (IOException -> String) -> IOException -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IOException -> String
forall e. Exception e => e -> String
displayException)
                  (IO ByteString -> ExceptT ColeUpdateProposalError IO ByteString)
-> IO ByteString -> ExceptT ColeUpdateProposalError IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
fp
  let mProposal :: Maybe ColeUpdateProposal
mProposal = AsType ColeUpdateProposal -> ByteString -> Maybe ColeUpdateProposal
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes AsType ColeUpdateProposal
AsColeUpdateProposal ByteString
proposalBs
  Either ColeUpdateProposalError ColeUpdateProposal
-> ExceptT ColeUpdateProposalError IO ColeUpdateProposal
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ColeUpdateProposalError ColeUpdateProposal
 -> ExceptT ColeUpdateProposalError IO ColeUpdateProposal)
-> Either ColeUpdateProposalError ColeUpdateProposal
-> ExceptT ColeUpdateProposalError IO ColeUpdateProposal
forall a b. (a -> b) -> a -> b
$ Either ColeUpdateProposalError ColeUpdateProposal
-> (ColeUpdateProposal
    -> Either ColeUpdateProposalError ColeUpdateProposal)
-> Maybe ColeUpdateProposal
-> Either ColeUpdateProposalError ColeUpdateProposal
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ColeUpdateProposalError
-> Either ColeUpdateProposalError ColeUpdateProposal
forall a b. a -> Either a b
Left (ColeUpdateProposalError
 -> Either ColeUpdateProposalError ColeUpdateProposal)
-> ColeUpdateProposalError
-> Either ColeUpdateProposalError ColeUpdateProposal
forall a b. (a -> b) -> a -> b
$ String -> ColeUpdateProposalError
UpdateProposalDecodingError String
fp) ColeUpdateProposal
-> Either ColeUpdateProposalError ColeUpdateProposal
forall a b. b -> Either a b
Right Maybe ColeUpdateProposal
mProposal

submitColeUpdateProposal
  :: NetworkId
  -> FilePath
  -> ExceptT ColeUpdateProposalError IO ()
submitColeUpdateProposal :: NetworkId -> String -> ExceptT ColeUpdateProposalError IO ()
submitColeUpdateProposal NetworkId
network String
proposalFp = do
    ColeUpdateProposal
proposal  <- String -> ExceptT ColeUpdateProposalError IO ColeUpdateProposal
readColeUpdateProposal String
proposalFp
    let genTx :: GenTx ColeBlock
genTx = ColeUpdateProposal -> GenTx ColeBlock
toColeLedgerUpdateProposal ColeUpdateProposal
proposal
    Tracer (ExceptT ColeUpdateProposalError IO) String
-> String -> ExceptT ColeUpdateProposalError IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer (ExceptT ColeUpdateProposalError IO) String
forall (m :: * -> *). MonadIO m => Tracer m String
stdoutTracer (String -> ExceptT ColeUpdateProposalError IO ())
-> String -> ExceptT ColeUpdateProposalError IO ()
forall a b. (a -> b) -> a -> b
$
      String
"Update proposal 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 -> ColeUpdateProposalError)
-> ExceptT ColeTxError IO ()
-> ExceptT ColeUpdateProposalError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ColeTxError -> ColeUpdateProposalError
ColeUpdateProposalTxError (ExceptT ColeTxError IO ()
 -> ExceptT ColeUpdateProposalError IO ())
-> ExceptT ColeTxError IO ()
-> ExceptT ColeUpdateProposalError IO ()
forall a b. (a -> b) -> a -> b
$ NetworkId -> GenTx ColeBlock -> ExceptT ColeTxError IO ()
nodeSubmitTx NetworkId
network GenTx ColeBlock
genTx