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

module Cardano.CLI.Byron.UpdateProposal
  ( ByronUpdateProposalError (..)
  , runProposalCreation
  , readByronUpdateProposal
  , renderByronUpdateProposalError
  , submitByronUpdateProposal
  )
where

import           Cardano.Api
import           Cardano.Api.Byron (AsType (AsByronUpdateProposal), ByronProtocolParametersUpdate,
                   ByronUpdateProposal, makeByronUpdateProposal, toByronLedgerUpdateProposal)
import qualified Cardano.Api.Byron as Byron
import           Cardano.Api.Consensus (condense, txId)

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, renderHelpersError)
import           Cardano.CLI.Types.Common

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

data ByronUpdateProposalError
  = ByronReadUpdateProposalFileFailure !FilePath !Text
  | ByronUpdateProposalWriteError !HelpersError
  | ByronUpdateProposalGenesisReadError !FilePath !ByronGenesisError
  | ByronUpdateProposalTxError !ByronTxError
  | ReadSigningKeyFailure !FilePath !ByronKeyFailure
  | UpdateProposalDecodingError !FilePath
  deriving Int -> ByronUpdateProposalError -> ShowS
[ByronUpdateProposalError] -> ShowS
ByronUpdateProposalError -> [Char]
(Int -> ByronUpdateProposalError -> ShowS)
-> (ByronUpdateProposalError -> [Char])
-> ([ByronUpdateProposalError] -> ShowS)
-> Show ByronUpdateProposalError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronUpdateProposalError -> ShowS
showsPrec :: Int -> ByronUpdateProposalError -> ShowS
$cshow :: ByronUpdateProposalError -> [Char]
show :: ByronUpdateProposalError -> [Char]
$cshowList :: [ByronUpdateProposalError] -> ShowS
showList :: [ByronUpdateProposalError] -> ShowS
Show

renderByronUpdateProposalError :: ByronUpdateProposalError -> Doc ann
renderByronUpdateProposalError :: forall ann. ByronUpdateProposalError -> Doc ann
renderByronUpdateProposalError = \case
  ByronReadUpdateProposalFileFailure [Char]
fp Text
rErr ->
    Doc ann
"Error reading update proposal at " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow [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 a ann. Show a => a -> Doc ann
pshow Text
rErr
  ByronUpdateProposalWriteError HelpersError
hErr ->
    Doc ann
"Error writing update proposal: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> HelpersError -> Doc ann
forall ann. HelpersError -> Doc ann
renderHelpersError HelpersError
hErr
  ByronUpdateProposalGenesisReadError [Char]
fp ByronGenesisError
rErr ->
    Doc ann
"Error reading update proposal at: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow [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
<> ByronGenesisError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ByronGenesisError
rErr
  ByronUpdateProposalTxError ByronTxError
txErr ->
    Doc ann
"Error submitting update proposal: " 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
  ReadSigningKeyFailure [Char]
fp ByronKeyFailure
rErr ->
    Doc ann
"Error reading signing key at: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow [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
<> ByronKeyFailure -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ByronKeyFailure
rErr
  UpdateProposalDecodingError [Char]
fp ->
    Doc ann
"Error decoding update proposal at: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow [Char]
fp

runProposalCreation
  :: NetworkId
  -> SigningKeyFile In
  -> Byron.ProtocolVersion
  -> Byron.SoftwareVersion
  -> Byron.SystemTag
  -> Byron.InstallerHash
  -> FilePath
  -> ByronProtocolParametersUpdate
  -> ExceptT ByronUpdateProposalError IO ()
runProposalCreation :: NetworkId
-> SigningKeyFile 'In
-> ProtocolVersion
-> SoftwareVersion
-> SystemTag
-> InstallerHash
-> [Char]
-> ByronProtocolParametersUpdate
-> ExceptT ByronUpdateProposalError IO ()
runProposalCreation
  NetworkId
nw
  sKey :: SigningKeyFile 'In
sKey@(File [Char]
sKeyfp)
  ProtocolVersion
pVer
  SoftwareVersion
sVer
  SystemTag
sysTag
  InstallerHash
insHash
  [Char]
outputFp
  ByronProtocolParametersUpdate
params = do
    SomeByronSigningKey
sK <- (ByronKeyFailure -> ByronUpdateProposalError)
-> ExceptT ByronKeyFailure IO SomeByronSigningKey
-> ExceptT ByronUpdateProposalError IO SomeByronSigningKey
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ([Char] -> ByronKeyFailure -> ByronUpdateProposalError
ReadSigningKeyFailure [Char]
sKeyfp) (ExceptT ByronKeyFailure IO SomeByronSigningKey
 -> ExceptT ByronUpdateProposalError IO SomeByronSigningKey)
-> ExceptT ByronKeyFailure IO SomeByronSigningKey
-> ExceptT ByronUpdateProposalError IO SomeByronSigningKey
forall a b. (a -> b) -> a -> b
$ ByronKeyFormat
-> SigningKeyFile 'In
-> ExceptT ByronKeyFailure IO SomeByronSigningKey
readByronSigningKey ByronKeyFormat
NonLegacyByronKeyFormat SigningKeyFile 'In
sKey
    let proposal :: ByronUpdateProposal
proposal = NetworkId
-> ProtocolVersion
-> SoftwareVersion
-> SystemTag
-> InstallerHash
-> SomeByronSigningKey
-> ByronProtocolParametersUpdate
-> ByronUpdateProposal
makeByronUpdateProposal NetworkId
nw ProtocolVersion
pVer SoftwareVersion
sVer SystemTag
sysTag InstallerHash
insHash SomeByronSigningKey
sK ByronProtocolParametersUpdate
params
    (HelpersError -> ByronUpdateProposalError)
-> ExceptT HelpersError IO ()
-> ExceptT ByronUpdateProposalError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ByronUpdateProposalError
ByronUpdateProposalWriteError (ExceptT HelpersError IO ()
 -> ExceptT ByronUpdateProposalError IO ())
-> ExceptT HelpersError IO ()
-> ExceptT ByronUpdateProposalError IO ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> ByteString -> ExceptT HelpersError IO ()
ensureNewFileLBS [Char]
outputFp (ByteString -> ExceptT HelpersError IO ())
-> ByteString -> ExceptT HelpersError IO ()
forall a b. (a -> b) -> a -> b
$
        ByronUpdateProposal -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes ByronUpdateProposal
proposal

readByronUpdateProposal :: FilePath -> ExceptT ByronUpdateProposalError IO ByronUpdateProposal
readByronUpdateProposal :: [Char] -> ExceptT ByronUpdateProposalError IO ByronUpdateProposal
readByronUpdateProposal [Char]
fp = do
  ByteString
proposalBs <-
    (IOException -> ByronUpdateProposalError)
-> IO ByteString -> ExceptT ByronUpdateProposalError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT ([Char] -> Text -> ByronUpdateProposalError
ByronReadUpdateProposalFileFailure [Char]
fp (Text -> ByronUpdateProposalError)
-> (IOException -> Text) -> IOException -> ByronUpdateProposalError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack ([Char] -> Text) -> (IOException -> [Char]) -> IOException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> [Char]
forall e. Exception e => e -> [Char]
displayException) (IO ByteString -> ExceptT ByronUpdateProposalError IO ByteString)
-> IO ByteString -> ExceptT ByronUpdateProposalError IO ByteString
forall a b. (a -> b) -> a -> b
$
      [Char] -> IO ByteString
BS.readFile [Char]
fp
  let proposalResult :: Either SerialiseAsRawBytesError ByronUpdateProposal
proposalResult = AsType ByronUpdateProposal
-> ByteString
-> Either SerialiseAsRawBytesError ByronUpdateProposal
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType ByronUpdateProposal
AsByronUpdateProposal ByteString
proposalBs
  Either ByronUpdateProposalError ByronUpdateProposal
-> ExceptT ByronUpdateProposalError IO ByronUpdateProposal
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ByronUpdateProposalError ByronUpdateProposal
 -> ExceptT ByronUpdateProposalError IO ByronUpdateProposal)
-> Either ByronUpdateProposalError ByronUpdateProposal
-> ExceptT ByronUpdateProposalError IO ByronUpdateProposal
forall a b. (a -> b) -> a -> b
$ (SerialiseAsRawBytesError -> ByronUpdateProposalError)
-> Either SerialiseAsRawBytesError ByronUpdateProposal
-> Either ByronUpdateProposalError ByronUpdateProposal
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 (ByronUpdateProposalError
-> SerialiseAsRawBytesError -> ByronUpdateProposalError
forall a b. a -> b -> a
const ([Char] -> ByronUpdateProposalError
UpdateProposalDecodingError [Char]
fp)) Either SerialiseAsRawBytesError ByronUpdateProposal
proposalResult

submitByronUpdateProposal
  :: SocketPath
  -> NetworkId
  -> FilePath
  -> ExceptT ByronUpdateProposalError IO ()
submitByronUpdateProposal :: SocketPath
-> NetworkId -> [Char] -> ExceptT ByronUpdateProposalError IO ()
submitByronUpdateProposal SocketPath
nodeSocketPath NetworkId
network [Char]
proposalFp = do
  ByronUpdateProposal
proposal <- [Char] -> ExceptT ByronUpdateProposalError IO ByronUpdateProposal
readByronUpdateProposal [Char]
proposalFp
  let genTx :: GenTx ByronBlock
genTx = ByronUpdateProposal -> GenTx ByronBlock
toByronLedgerUpdateProposal ByronUpdateProposal
proposal
  Tracer (ExceptT ByronUpdateProposalError IO) [Char]
-> [Char] -> ExceptT ByronUpdateProposalError IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer (ExceptT ByronUpdateProposalError IO) [Char]
forall (m :: * -> *). MonadIO m => Tracer m [Char]
stdoutTracer ([Char] -> ExceptT ByronUpdateProposalError IO ())
-> [Char] -> ExceptT ByronUpdateProposalError IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Update proposal 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 -> ByronUpdateProposalError)
-> ExceptT ByronTxError IO ()
-> ExceptT ByronUpdateProposalError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronTxError -> ByronUpdateProposalError
ByronUpdateProposalTxError (ExceptT ByronTxError IO ()
 -> ExceptT ByronUpdateProposalError IO ())
-> ExceptT ByronTxError IO ()
-> ExceptT ByronUpdateProposalError IO ()
forall a b. (a -> b) -> a -> b
$ SocketPath
-> NetworkId -> GenTx ByronBlock -> ExceptT ByronTxError IO ()
nodeSubmitTx SocketPath
nodeSocketPath NetworkId
network GenTx ByronBlock
genTx