{-# 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 ->
      -- TODO: Write render function for Shelley tx submission errors.
      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) ->
      -- TODO: Write render function for Shelley tx submission errors.
      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