{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
module Cardano.Api.TxSubmit
( submitTx
, TxForMode(..)
, TxSubmitResultForMode(..)
, renderTxSubmitResult
) where
import Cardano.Prelude
import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult (..))
import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr)
import Ouroboros.Consensus.Byron.Ledger (ByronBlock)
import qualified Ouroboros.Consensus.Byron.Ledger as Byron
import Ouroboros.Consensus.Cardano.Block (CardanoApplyTxErr,
GenTx (GenTxByron, GenTxShelley),
HardForkApplyTxErr (ApplyTxErrAllegra, ApplyTxErrByron, ApplyTxErrMary, ApplyTxErrShelley, ApplyTxErrWrongEra))
import Ouroboros.Consensus.HardFork.Combinator.Degenerate
import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock, mkShelleyTx)
import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto)
import Cardano.Api.TxSubmit.ErrorRender
import Cardano.Api.Typed
data TxForMode mode where
TxForByronMode
:: Tx Byron
-> TxForMode ByronMode
TxForShelleyMode
:: Tx Shelley
-> TxForMode ShelleyMode
TxForCardanoMode
:: Either (Tx Byron) (Tx Shelley)
-> TxForMode CardanoMode
data TxSubmitResultForMode mode where
TxSubmitSuccess
:: TxSubmitResultForMode mode
TxSubmitFailureByronMode
:: ApplyTxErr ByronBlock
-> TxSubmitResultForMode ByronMode
TxSubmitFailureShelleyMode
:: ApplyTxErr (ShelleyBlock StandardShelley)
-> TxSubmitResultForMode ShelleyMode
TxSubmitFailureCardanoMode
:: CardanoApplyTxErr StandardCrypto
-> TxSubmitResultForMode CardanoMode
deriving instance Show (TxSubmitResultForMode ByronMode)
deriving instance Show (TxSubmitResultForMode ShelleyMode)
deriving instance Show (TxSubmitResultForMode CardanoMode)
submitTx :: forall mode block.
LocalNodeConnectInfo mode block
-> TxForMode mode
-> IO (TxSubmitResultForMode mode)
submitTx :: LocalNodeConnectInfo mode block
-> TxForMode mode -> IO (TxSubmitResultForMode mode)
submitTx LocalNodeConnectInfo mode block
connctInfo TxForMode mode
txformode =
case (LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
forall mode block.
LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
localNodeConsensusMode LocalNodeConnectInfo mode block
connctInfo, TxForMode mode
txformode) of
(ByronMode{}, TxForByronMode (ByronTx ATxAux ByteString
tx)) -> do
let genTx :: GenTx (HardForkBlock '[ByronBlock])
genTx = GenTx ByronBlock -> GenTx (HardForkBlock '[ByronBlock])
forall b. NoHardForks b => GenTx b -> GenTx (HardForkBlock '[b])
DegenGenTx (TxId -> ATxAux ByteString -> GenTx ByronBlock
Byron.ByronTx (ATxAux ByteString -> TxId
Byron.byronIdTx ATxAux ByteString
tx) ATxAux ByteString
tx)
SubmitResult (HardForkApplyTxErr '[ByronBlock])
result <- LocalNodeConnectInfo mode block
-> GenTx block -> IO (SubmitResult (ApplyTxErr block))
forall mode block.
(ShowProxy block, ShowProxy (ApplyTxErr block),
ShowProxy (Query block), ShowProxy (GenTx block),
ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> GenTx block -> IO (SubmitResult (ApplyTxErr block))
submitTxToNodeLocal LocalNodeConnectInfo mode block
connctInfo GenTx block
GenTx (HardForkBlock '[ByronBlock])
genTx
case SubmitResult (HardForkApplyTxErr '[ByronBlock])
result of
SubmitResult (HardForkApplyTxErr '[ByronBlock])
SubmitSuccess ->
TxSubmitResultForMode mode -> IO (TxSubmitResultForMode mode)
forall (m :: * -> *) a. Monad m => a -> m a
return TxSubmitResultForMode mode
forall mode. TxSubmitResultForMode mode
TxSubmitSuccess
SubmitFail (DegenApplyTxErr ApplyTxErr ByronBlock
failure) ->
TxSubmitResultForMode ByronMode
-> IO (TxSubmitResultForMode ByronMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplyTxErr ByronBlock -> TxSubmitResultForMode ByronMode
TxSubmitFailureByronMode ApplyTxErr ByronBlock
failure)
(ShelleyMode{}, TxForShelleyMode (ShelleyTx Tx StandardShelley
tx)) -> do
let genTx :: GenTx (HardForkBlock '[ShelleyBlock StandardShelley])
genTx = GenTx (ShelleyBlock StandardShelley)
-> GenTx (HardForkBlock '[ShelleyBlock StandardShelley])
forall b. NoHardForks b => GenTx b -> GenTx (HardForkBlock '[b])
DegenGenTx (Tx StandardShelley -> GenTx (ShelleyBlock StandardShelley)
forall era.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock era)
mkShelleyTx Tx StandardShelley
tx)
SubmitResult (HardForkApplyTxErr '[ShelleyBlock StandardShelley])
result <- LocalNodeConnectInfo mode block
-> GenTx block -> IO (SubmitResult (ApplyTxErr block))
forall mode block.
(ShowProxy block, ShowProxy (ApplyTxErr block),
ShowProxy (Query block), ShowProxy (GenTx block),
ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> GenTx block -> IO (SubmitResult (ApplyTxErr block))
submitTxToNodeLocal LocalNodeConnectInfo mode block
connctInfo GenTx block
GenTx (HardForkBlock '[ShelleyBlock StandardShelley])
genTx
case SubmitResult (HardForkApplyTxErr '[ShelleyBlock StandardShelley])
result of
SubmitResult (HardForkApplyTxErr '[ShelleyBlock StandardShelley])
SubmitSuccess ->
TxSubmitResultForMode mode -> IO (TxSubmitResultForMode mode)
forall (m :: * -> *) a. Monad m => a -> m a
return TxSubmitResultForMode mode
forall mode. TxSubmitResultForMode mode
TxSubmitSuccess
SubmitFail (DegenApplyTxErr ApplyTxErr (ShelleyBlock StandardShelley)
failure) ->
TxSubmitResultForMode ShelleyMode
-> IO (TxSubmitResultForMode ShelleyMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplyTxErr (ShelleyBlock StandardShelley)
-> TxSubmitResultForMode ShelleyMode
TxSubmitFailureShelleyMode ApplyTxErr (ShelleyBlock StandardShelley)
failure)
(CardanoMode{}, TxForCardanoMode Either (Tx Byron) (Tx Shelley)
etx) -> do
let genTx :: GenTx block
genTx = case Either (Tx Byron) (Tx Shelley)
etx of
Left (ByronTx ATxAux ByteString
tx) -> GenTx ByronBlock -> CardanoGenTx StandardCrypto
forall c. GenTx ByronBlock -> CardanoGenTx c
GenTxByron (TxId -> ATxAux ByteString -> GenTx ByronBlock
Byron.ByronTx (ATxAux ByteString -> TxId
Byron.byronIdTx ATxAux ByteString
tx) ATxAux ByteString
tx)
Right (ShelleyTx Tx StandardShelley
tx) -> GenTx (ShelleyBlock StandardShelley) -> CardanoGenTx StandardCrypto
forall c. GenTx (ShelleyBlock (ShelleyEra c)) -> CardanoGenTx c
GenTxShelley (Tx StandardShelley -> GenTx (ShelleyBlock StandardShelley)
forall era.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock era)
mkShelleyTx Tx StandardShelley
tx)
SubmitResult (CardanoApplyTxErr StandardCrypto)
result <- LocalNodeConnectInfo mode block
-> GenTx block -> IO (SubmitResult (ApplyTxErr block))
forall mode block.
(ShowProxy block, ShowProxy (ApplyTxErr block),
ShowProxy (Query block), ShowProxy (GenTx block),
ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> GenTx block -> IO (SubmitResult (ApplyTxErr block))
submitTxToNodeLocal LocalNodeConnectInfo mode block
connctInfo GenTx block
genTx
case SubmitResult (CardanoApplyTxErr StandardCrypto)
result of
SubmitResult (CardanoApplyTxErr StandardCrypto)
SubmitSuccess -> TxSubmitResultForMode mode -> IO (TxSubmitResultForMode mode)
forall (m :: * -> *) a. Monad m => a -> m a
return TxSubmitResultForMode mode
forall mode. TxSubmitResultForMode mode
TxSubmitSuccess
SubmitFail CardanoApplyTxErr StandardCrypto
failure -> TxSubmitResultForMode CardanoMode
-> IO (TxSubmitResultForMode CardanoMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (CardanoApplyTxErr StandardCrypto
-> TxSubmitResultForMode CardanoMode
TxSubmitFailureCardanoMode CardanoApplyTxErr StandardCrypto
failure)
renderTxSubmitResult :: TxSubmitResultForMode mode -> Text
renderTxSubmitResult :: TxSubmitResultForMode mode -> Text
renderTxSubmitResult TxSubmitResultForMode mode
res =
case TxSubmitResultForMode mode
res of
TxSubmitResultForMode mode
TxSubmitSuccess -> Text
"Transaction submitted successfully."
TxSubmitFailureByronMode ApplyTxErr ByronBlock
err ->
Text
"Failed to submit Byron transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ApplyMempoolPayloadErr -> Text
renderApplyMempoolPayloadErr ApplyMempoolPayloadErr
ApplyTxErr ByronBlock
err
TxSubmitFailureShelleyMode ApplyTxErr (ShelleyBlock StandardShelley)
err ->
Text
"Failed to submit Shelley transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ApplyTxError StandardShelley -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show ApplyTxErr (ShelleyBlock StandardShelley)
ApplyTxError StandardShelley
err
TxSubmitFailureCardanoMode (ApplyTxErrByron ApplyTxErr ByronBlock
err) ->
Text
"Failed to submit Byron transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ApplyMempoolPayloadErr -> Text
renderApplyMempoolPayloadErr ApplyMempoolPayloadErr
ApplyTxErr ByronBlock
err
TxSubmitFailureCardanoMode (ApplyTxErrShelley ApplyTxErr (ShelleyBlock StandardShelley)
err) ->
Text
"Failed to submit Shelley transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ApplyTxError StandardShelley -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show ApplyTxErr (ShelleyBlock StandardShelley)
ApplyTxError StandardShelley
err
TxSubmitFailureCardanoMode (ApplyTxErrMary ApplyTxErr (ShelleyBlock StandardShelley)
err) ->
Text
"Failed to submit Mary transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ApplyTxError StandardShelley -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show ApplyTxErr (ShelleyBlock StandardShelley)
ApplyTxError StandardShelley
err
TxSubmitFailureCardanoMode (ApplyTxErrAllegra ApplyTxErr (ShelleyBlock StandardShelley)
err) ->
Text
"Failed to submit Allegra transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ApplyTxError StandardShelley -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show ApplyTxErr (ShelleyBlock StandardShelley)
ApplyTxError StandardShelley
err
TxSubmitFailureCardanoMode (ApplyTxErrWrongEra EraMismatch
mismatch) ->
Text
"Failed to submit transaction due to era mismatch: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EraMismatch -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show EraMismatch
mismatch