{-# LANGUAGE GADTs #-}

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

import           Cardano.Prelude

import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither)
import           Control.Tracer (stdoutTracer, traceWith)
import qualified Data.ByteString.Lazy as LB
import qualified Data.Map.Strict as M

import qualified Cardano.Binary as Binary
import           Cardano.Chain.Common (LovelacePortion, TxFeePolicy (..))
import           Cardano.Chain.Slotting (EpochNumber (..), SlotNumber (..))
import           Cardano.Chain.Update (AProposal (..), InstallerHash (..), Proposal,
                     ProposalBody (..), ProtocolParametersUpdate (..), ProtocolVersion (..),
                     SoftforkRule (..), SoftwareVersion (..), SystemTag (..), recoverUpId,
                     signProposal)
import           Cardano.CLI.Helpers (HelpersError, ensureNewFileLBS, renderHelpersError, textShow)
import           Cardano.Crypto.Signing (SigningKey, noPassSafeSigner)
import           Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
import qualified Ouroboros.Consensus.Byron.Ledger.Mempool as Mempool
import           Ouroboros.Consensus.Ledger.SupportsMempool (txId)
import           Ouroboros.Consensus.Util.Condense (condense)

import           Cardano.Api.Typed (NetworkId, toByronProtocolMagicId)
import           Cardano.CLI.Byron.Genesis (ByronGenesisError)
import           Cardano.CLI.Byron.Key (ByronKeyFailure, CardanoEra (..), readEraSigningKey)
import           Cardano.CLI.Byron.Tx (ByronTxError, nodeSubmitTx)
import           Cardano.CLI.Types

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

renderByronUpdateProposalError :: ByronUpdateProposalError -> Text
renderByronUpdateProposalError :: ByronUpdateProposalError -> Text
renderByronUpdateProposalError ByronUpdateProposalError
err =
  case ByronUpdateProposalError
err of
    ByronReadUpdateProposalFileFailure 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
    ByronUpdateProposalWriteError HelpersError
hErr ->
      Text
"Error writing update proposal: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HelpersError -> Text
renderHelpersError HelpersError
hErr
    ByronUpdateProposalGenesisReadError String
fp ByronGenesisError
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
<> ByronGenesisError -> Text
forall a. Show a => a -> Text
textShow ByronGenesisError
rErr
    ByronUpdateProposalTxError ByronTxError
txErr ->
      Text
"Error submitting update proposal: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByronTxError -> Text
forall a. Show a => a -> Text
textShow ByronTxError
txErr
    ReadSigningKeyFailure String
fp ByronKeyFailure
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
<> ByronKeyFailure -> Text
forall a. Show a => a -> Text
textShow ByronKeyFailure
rErr
    UpdateProposalDecodingError DecoderError
decErr ->
      Text
"Error decoding update proposal: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Text
forall a. Show a => a -> Text
textShow DecoderError
decErr

runProposalCreation
  :: NetworkId
  -> SigningKeyFile
  -> ProtocolVersion
  -> SoftwareVersion
  -> SystemTag
  -> InstallerHash
  -> FilePath
  -> [ParametersToUpdate]
  -> ExceptT ByronUpdateProposalError IO ()
runProposalCreation :: NetworkId
-> SigningKeyFile
-> ProtocolVersion
-> SoftwareVersion
-> SystemTag
-> InstallerHash
-> String
-> [ParametersToUpdate]
-> ExceptT ByronUpdateProposalError IO ()
runProposalCreation NetworkId
nw sKey :: SigningKeyFile
sKey@(SigningKeyFile String
sKeyfp) ProtocolVersion
pVer SoftwareVersion
sVer
                    SystemTag
sysTag InstallerHash
insHash String
outputFp [ParametersToUpdate]
params = do
  SigningKey
sK <- (ByronKeyFailure -> ByronUpdateProposalError)
-> ExceptT ByronKeyFailure IO SigningKey
-> ExceptT ByronUpdateProposalError IO SigningKey
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> ByronKeyFailure -> ByronUpdateProposalError
ReadSigningKeyFailure String
sKeyfp) (ExceptT ByronKeyFailure IO SigningKey
 -> ExceptT ByronUpdateProposalError IO SigningKey)
-> ExceptT ByronKeyFailure IO SigningKey
-> ExceptT ByronUpdateProposalError IO SigningKey
forall a b. (a -> b) -> a -> b
$ CardanoEra
-> SigningKeyFile -> ExceptT ByronKeyFailure IO SigningKey
readEraSigningKey CardanoEra
ByronEra SigningKeyFile
sKey
  let proposal :: Proposal
proposal = NetworkId
-> SigningKey
-> ProtocolVersion
-> SoftwareVersion
-> SystemTag
-> InstallerHash
-> [ParametersToUpdate]
-> Proposal
createUpdateProposal NetworkId
nw SigningKey
sK ProtocolVersion
pVer SoftwareVersion
sVer SystemTag
sysTag InstallerHash
insHash [ParametersToUpdate]
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
$
    String -> ByteString -> ExceptT HelpersError IO ()
ensureNewFileLBS String
outputFp (Proposal -> ByteString
serialiseByronUpdateProposal Proposal
proposal)


data ParametersToUpdate =
    ScriptVersion Word16
  | SlotDuration Natural
  | MaxBlockSize Natural
  | MaxHeaderSize Natural
  | MaxTxSize Natural
  | MaxProposalSize Natural
  | MpcThd LovelacePortion
  | HeavyDelThd LovelacePortion
  | UpdateVoteThd LovelacePortion
  -- ^ UpdateVoteThd: This represents the minimum percentage of the total number of genesis
  -- keys that have to endorse a protocol version to be able to become adopted.
  | UpdateProposalThd LovelacePortion
  -- ^ UpdateProposalTTL: If after the number of slots specified the proposal
  -- does not reach majority of approvals, the proposal is simply discarded.
  | UpdateProposalTTL SlotNumber
  | SoftforkRuleParam SoftforkRule
  | TxFeePolicy TxFeePolicy
  | UnlockStakeEpoch EpochNumber
  deriving Int -> ParametersToUpdate -> ShowS
[ParametersToUpdate] -> ShowS
ParametersToUpdate -> String
(Int -> ParametersToUpdate -> ShowS)
-> (ParametersToUpdate -> String)
-> ([ParametersToUpdate] -> ShowS)
-> Show ParametersToUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParametersToUpdate] -> ShowS
$cshowList :: [ParametersToUpdate] -> ShowS
show :: ParametersToUpdate -> String
$cshow :: ParametersToUpdate -> String
showsPrec :: Int -> ParametersToUpdate -> ShowS
$cshowsPrec :: Int -> ParametersToUpdate -> ShowS
Show

createProtocolParametersUpdate
  :: ProtocolParametersUpdate
  -> [ParametersToUpdate]
  -> ProtocolParametersUpdate
createProtocolParametersUpdate :: ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
createProtocolParametersUpdate = ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go
 where go :: ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i [] = ProtocolParametersUpdate
i
       go ProtocolParametersUpdate
i (ParametersToUpdate
paramToUpdate : [ParametersToUpdate]
rest) =
         case ParametersToUpdate
paramToUpdate of
           ScriptVersion Word16
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuScriptVersion :: Maybe Word16
ppuScriptVersion = Word16 -> Maybe Word16
forall a. a -> Maybe a
Just Word16
val} [ParametersToUpdate]
rest
           SlotDuration Natural
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuSlotDuration :: Maybe Natural
ppuSlotDuration = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
val} [ParametersToUpdate]
rest
           MaxBlockSize Natural
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuMaxBlockSize :: Maybe Natural
ppuMaxBlockSize = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
val} [ParametersToUpdate]
rest
           MaxHeaderSize Natural
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuMaxHeaderSize :: Maybe Natural
ppuMaxHeaderSize = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
val} [ParametersToUpdate]
rest
           MaxTxSize Natural
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuMaxTxSize :: Maybe Natural
ppuMaxTxSize = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
val} [ParametersToUpdate]
rest
           MaxProposalSize Natural
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuMaxProposalSize :: Maybe Natural
ppuMaxProposalSize = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
val} [ParametersToUpdate]
rest
           MpcThd LovelacePortion
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuMpcThd :: Maybe LovelacePortion
ppuMpcThd = LovelacePortion -> Maybe LovelacePortion
forall a. a -> Maybe a
Just LovelacePortion
val} [ParametersToUpdate]
rest
           HeavyDelThd LovelacePortion
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuHeavyDelThd :: Maybe LovelacePortion
ppuHeavyDelThd = LovelacePortion -> Maybe LovelacePortion
forall a. a -> Maybe a
Just LovelacePortion
val} [ParametersToUpdate]
rest
           UpdateVoteThd LovelacePortion
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuUpdateVoteThd :: Maybe LovelacePortion
ppuUpdateVoteThd = LovelacePortion -> Maybe LovelacePortion
forall a. a -> Maybe a
Just LovelacePortion
val} [ParametersToUpdate]
rest
           UpdateProposalThd LovelacePortion
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuUpdateProposalThd :: Maybe LovelacePortion
ppuUpdateProposalThd = LovelacePortion -> Maybe LovelacePortion
forall a. a -> Maybe a
Just LovelacePortion
val} [ParametersToUpdate]
rest
           UpdateProposalTTL SlotNumber
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuUpdateProposalTTL :: Maybe SlotNumber
ppuUpdateProposalTTL = SlotNumber -> Maybe SlotNumber
forall a. a -> Maybe a
Just SlotNumber
val} [ParametersToUpdate]
rest
           SoftforkRuleParam SoftforkRule
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuSoftforkRule :: Maybe SoftforkRule
ppuSoftforkRule = SoftforkRule -> Maybe SoftforkRule
forall a. a -> Maybe a
Just SoftforkRule
val} [ParametersToUpdate]
rest
           TxFeePolicy TxFeePolicy
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuTxFeePolicy :: Maybe TxFeePolicy
ppuTxFeePolicy = TxFeePolicy -> Maybe TxFeePolicy
forall a. a -> Maybe a
Just TxFeePolicy
val} [ParametersToUpdate]
rest
           UnlockStakeEpoch EpochNumber
val -> ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
go ProtocolParametersUpdate
i{ppuUnlockStakeEpoch :: Maybe EpochNumber
ppuUnlockStakeEpoch = EpochNumber -> Maybe EpochNumber
forall a. a -> Maybe a
Just EpochNumber
val} [ParametersToUpdate]
rest

convertProposalToGenTx :: AProposal ByteString -> Mempool.GenTx ByronBlock
convertProposalToGenTx :: AProposal ByteString -> GenTx ByronBlock
convertProposalToGenTx AProposal ByteString
prop = UpId -> AProposal ByteString -> GenTx ByronBlock
Mempool.ByronUpdateProposal (AProposal ByteString -> UpId
recoverUpId AProposal ByteString
prop) AProposal ByteString
prop

createUpdateProposal
  :: NetworkId
  -> SigningKey
  -> ProtocolVersion
  -> SoftwareVersion
  -> SystemTag
  -> InstallerHash
  -> [ParametersToUpdate]
  -> Proposal
createUpdateProposal :: NetworkId
-> SigningKey
-> ProtocolVersion
-> SoftwareVersion
-> SystemTag
-> InstallerHash
-> [ParametersToUpdate]
-> Proposal
createUpdateProposal NetworkId
nw SigningKey
sKey ProtocolVersion
pVer SoftwareVersion
sVer SystemTag
sysTag InstallerHash
inshash [ParametersToUpdate]
paramsToUpdate =
    ProtocolMagicId -> ProposalBody -> SafeSigner -> Proposal
signProposal (NetworkId -> ProtocolMagicId
toByronProtocolMagicId NetworkId
nw) ProposalBody
proposalBody SafeSigner
noPassSigningKey
  where
    proposalBody :: ProposalBody
proposalBody = ProtocolVersion
-> ProtocolParametersUpdate
-> SoftwareVersion
-> Map SystemTag InstallerHash
-> ProposalBody
ProposalBody ProtocolVersion
pVer ProtocolParametersUpdate
protocolParamsUpdate SoftwareVersion
sVer Map SystemTag InstallerHash
metaData

    metaData :: M.Map SystemTag InstallerHash
    metaData :: Map SystemTag InstallerHash
metaData = SystemTag -> InstallerHash -> Map SystemTag InstallerHash
forall k a. k -> a -> Map k a
M.singleton SystemTag
sysTag InstallerHash
inshash
    noPassSigningKey :: SafeSigner
noPassSigningKey = SigningKey -> SafeSigner
noPassSafeSigner SigningKey
sKey
    protocolParamsUpdate :: ProtocolParametersUpdate
protocolParamsUpdate = ProtocolParametersUpdate
-> [ParametersToUpdate] -> ProtocolParametersUpdate
createProtocolParametersUpdate
                             ProtocolParametersUpdate
emptyProtocolParametersUpdate [ParametersToUpdate]
paramsToUpdate

emptyProtocolParametersUpdate :: ProtocolParametersUpdate
emptyProtocolParametersUpdate :: ProtocolParametersUpdate
emptyProtocolParametersUpdate =
  ProtocolParametersUpdate :: Maybe Word16
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe SlotNumber
-> Maybe SoftforkRule
-> Maybe TxFeePolicy
-> Maybe EpochNumber
-> ProtocolParametersUpdate
ProtocolParametersUpdate
    { ppuScriptVersion :: Maybe Word16
ppuScriptVersion = Maybe Word16
forall a. Maybe a
Nothing
    , ppuSlotDuration :: Maybe Natural
ppuSlotDuration = Maybe Natural
forall a. Maybe a
Nothing
    , ppuMaxBlockSize :: Maybe Natural
ppuMaxBlockSize = Maybe Natural
forall a. Maybe a
Nothing
    , ppuMaxHeaderSize :: Maybe Natural
ppuMaxHeaderSize = Maybe Natural
forall a. Maybe a
Nothing
    , ppuMaxTxSize :: Maybe Natural
ppuMaxTxSize = Maybe Natural
forall a. Maybe a
Nothing
    , ppuMaxProposalSize :: Maybe Natural
ppuMaxProposalSize = Maybe Natural
forall a. Maybe a
Nothing
    , ppuMpcThd :: Maybe LovelacePortion
ppuMpcThd = Maybe LovelacePortion
forall a. Maybe a
Nothing
    , ppuHeavyDelThd :: Maybe LovelacePortion
ppuHeavyDelThd = Maybe LovelacePortion
forall a. Maybe a
Nothing
    , ppuUpdateVoteThd :: Maybe LovelacePortion
ppuUpdateVoteThd = Maybe LovelacePortion
forall a. Maybe a
Nothing
    , ppuUpdateProposalThd :: Maybe LovelacePortion
ppuUpdateProposalThd = Maybe LovelacePortion
forall a. Maybe a
Nothing
    , ppuUpdateProposalTTL :: Maybe SlotNumber
ppuUpdateProposalTTL = Maybe SlotNumber
forall a. Maybe a
Nothing
    , ppuSoftforkRule :: Maybe SoftforkRule
ppuSoftforkRule = Maybe SoftforkRule
forall a. Maybe a
Nothing
    , ppuTxFeePolicy :: Maybe TxFeePolicy
ppuTxFeePolicy = Maybe TxFeePolicy
forall a. Maybe a
Nothing
    , ppuUnlockStakeEpoch :: Maybe EpochNumber
ppuUnlockStakeEpoch = Maybe EpochNumber
forall a. Maybe a
Nothing
    }

serialiseByronUpdateProposal :: Proposal -> LByteString
serialiseByronUpdateProposal :: Proposal -> ByteString
serialiseByronUpdateProposal = Proposal -> ByteString
forall a. ToCBOR a => a -> ByteString
Binary.serialize

deserialiseByronUpdateProposal :: LByteString
                               -> Either ByronUpdateProposalError (AProposal ByteString)
deserialiseByronUpdateProposal :: ByteString
-> Either ByronUpdateProposalError (AProposal ByteString)
deserialiseByronUpdateProposal ByteString
bs =
  case ByteString -> Either DecoderError (AProposal ByteSpan)
forall a. FromCBOR a => ByteString -> Either DecoderError a
Binary.decodeFull ByteString
bs of
    Left DecoderError
deserFail -> ByronUpdateProposalError
-> Either ByronUpdateProposalError (AProposal ByteString)
forall a b. a -> Either a b
Left (ByronUpdateProposalError
 -> Either ByronUpdateProposalError (AProposal ByteString))
-> ByronUpdateProposalError
-> Either ByronUpdateProposalError (AProposal ByteString)
forall a b. (a -> b) -> a -> b
$ DecoderError -> ByronUpdateProposalError
UpdateProposalDecodingError DecoderError
deserFail
    Right AProposal ByteSpan
proposal -> AProposal ByteString
-> Either ByronUpdateProposalError (AProposal ByteString)
forall a b. b -> Either a b
Right (AProposal ByteString
 -> Either ByronUpdateProposalError (AProposal ByteString))
-> AProposal ByteString
-> Either ByronUpdateProposalError (AProposal ByteString)
forall a b. (a -> b) -> a -> b
$ AProposal ByteSpan -> AProposal ByteString
annotateProposal AProposal ByteSpan
proposal
 where
  annotateProposal :: AProposal Binary.ByteSpan -> AProposal ByteString
  annotateProposal :: AProposal ByteSpan -> AProposal ByteString
annotateProposal AProposal ByteSpan
proposal = ByteString -> AProposal ByteSpan -> AProposal ByteString
forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
Binary.annotationBytes ByteString
bs AProposal ByteSpan
proposal

readByronUpdateProposal :: FilePath -> ExceptT ByronUpdateProposalError IO LByteString
readByronUpdateProposal :: String -> ExceptT ByronUpdateProposalError IO ByteString
readByronUpdateProposal String
fp =
  (IOException -> ByronUpdateProposalError)
-> IO ByteString -> ExceptT ByronUpdateProposalError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> Text -> ByronUpdateProposalError
ByronReadUpdateProposalFileFailure String
fp (Text -> ByronUpdateProposalError)
-> (IOException -> Text) -> IOException -> ByronUpdateProposalError
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)
                  (String -> IO ByteString
LB.readFile String
fp)


submitByronUpdateProposal
  :: NetworkId
  -> FilePath
  -> ExceptT ByronUpdateProposalError IO ()
submitByronUpdateProposal :: NetworkId -> String -> ExceptT ByronUpdateProposalError IO ()
submitByronUpdateProposal NetworkId
network String
proposalFp = do
    ByteString
proposalBs <- String -> ExceptT ByronUpdateProposalError IO ByteString
readByronUpdateProposal String
proposalFp
    AProposal ByteString
aProposal <- Either ByronUpdateProposalError (AProposal ByteString)
-> ExceptT ByronUpdateProposalError IO (AProposal ByteString)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ByronUpdateProposalError (AProposal ByteString)
 -> ExceptT ByronUpdateProposalError IO (AProposal ByteString))
-> Either ByronUpdateProposalError (AProposal ByteString)
-> ExceptT ByronUpdateProposalError IO (AProposal ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString
-> Either ByronUpdateProposalError (AProposal ByteString)
deserialiseByronUpdateProposal ByteString
proposalBs
    let genTx :: GenTx ByronBlock
genTx = AProposal ByteString -> GenTx ByronBlock
convertProposalToGenTx AProposal ByteString
aProposal
    Tracer (ExceptT ByronUpdateProposalError IO) String
-> String -> ExceptT ByronUpdateProposalError IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer (ExceptT ByronUpdateProposalError IO) String
forall (m :: * -> *). MonadIO m => Tracer m String
stdoutTracer (String -> ExceptT ByronUpdateProposalError IO ())
-> String -> ExceptT ByronUpdateProposalError IO ()
forall a b. (a -> b) -> a -> b
$
      String
"Update proposal TxId: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxId (GenTx ByronBlock) -> String
forall a. Condense a => a -> String
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
$ NetworkId -> GenTx ByronBlock -> ExceptT ByronTxError IO ()
nodeSubmitTx NetworkId
network GenTx ByronBlock
genTx