{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.Rpc.Server.Internal.UtxoRpc.Submit
  ( submitTxMethod
  )
where

import Cardano.Api
import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as U5c
import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as UtxoRpc
import Cardano.Rpc.Server.Internal.Error
import Cardano.Rpc.Server.Internal.Monad
import Cardano.Rpc.Server.Internal.Orphans ()
import Cardano.Rpc.Server.Internal.Tracing

import Cardano.Ledger.Core qualified as L

import RIO hiding (toList)

import Data.Default
import GHC.Stack
import Network.GRPC.Spec

-- | Submit a CBOR-serialised list of transactions to the node
submitTxMethod
  :: MonadRpc e m
  => Proto UtxoRpc.SubmitTxRequest
  -> m (Proto UtxoRpc.SubmitTxResponse)
submitTxMethod :: forall e (m :: * -> *).
MonadRpc e m =>
Proto SubmitTxRequest -> m (Proto SubmitTxResponse)
submitTxMethod Proto SubmitTxRequest
req = do
  nodeConnInfo <- m LocalNodeConnectInfo
forall field env (m :: * -> *).
(Has field env, MonadReader env m) =>
m field
grab
  AnyCardanoEra era <- liftIO . throwExceptT $ determineEra nodeConnInfo
  eon <- forEraInEon era (error "Minimum Shelley era required") pure

  tx <-
    putTraceThrowEither
      . first TraceRpcSubmitTxDecodingError
      . deserialiseTx eon
      $ req ^. U5c.tx . U5c.raw

  txId' <- submitTx eon tx

  pure $ def & U5c.ref .~ serialiseToRawBytes txId'
 where
  deserialiseTx :: ShelleyBasedEra era -> ByteString -> Either DecoderError (Tx era)
  deserialiseTx :: forall era.
ShelleyBasedEra era -> ByteString -> Either DecoderError (Tx era)
deserialiseTx ShelleyBasedEra era
sbe = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    ByteString -> Either DecoderError (Tx era))
-> ByteString
-> Either DecoderError (Tx era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  ByteString -> Either DecoderError (Tx era))
 -> ByteString -> Either DecoderError (Tx era))
-> (ShelleyBasedEraConstraints era =>
    ByteString -> Either DecoderError (Tx era))
-> ByteString
-> Either DecoderError (Tx era)
forall a b. (a -> b) -> a -> b
$ AsType (Tx era) -> ByteString -> Either DecoderError (Tx era)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType (Tx era)
forall t. HasTypeProxy t => AsType t
asType

  submitTx
    :: MonadRpc e m
    => ShelleyBasedEra era
    -> Tx era
    -> m TxId
  submitTx :: forall e (m :: * -> *) era.
MonadRpc e m =>
ShelleyBasedEra era -> Tx era -> m TxId
submitTx ShelleyBasedEra era
sbe Tx era
tx = do
    nodeConnInfo <- m LocalNodeConnectInfo
forall field env (m :: * -> *).
(Has field env, MonadReader env m) =>
m field
grab
    result <-
      submitTxToNodeLocal nodeConnInfo (TxInMode sbe tx) <&> \case
        TxSubmitError SomeException
e -> TraceRpcSubmit -> Either TraceRpcSubmit TxId
forall a b. a -> Either a b
Left (TraceRpcSubmit -> Either TraceRpcSubmit TxId)
-> TraceRpcSubmit -> Either TraceRpcSubmit TxId
forall a b. (a -> b) -> a -> b
$ SomeException -> TraceRpcSubmit
TraceRpcSubmitN2cConnectionError SomeException
e
        TxSubmitFail TxValidationErrorInCardanoMode
reason -> TraceRpcSubmit -> Either TraceRpcSubmit TxId
forall a b. a -> Either a b
Left (TraceRpcSubmit -> Either TraceRpcSubmit TxId)
-> TraceRpcSubmit -> Either TraceRpcSubmit TxId
forall a b. (a -> b) -> a -> b
$ TxValidationErrorInCardanoMode -> TraceRpcSubmit
TraceRpcSubmitTxValidationError TxValidationErrorInCardanoMode
reason
        TxSubmitResult
TxSubmitSuccess ->
          let ShelleyTx ShelleyBasedEra era
_ Tx TopTx (ShelleyLedgerEra era)
ledgerTx = Tx era
tx
           in TxId -> Either TraceRpcSubmit TxId
forall a b. b -> Either a b
Right (TxId -> Either TraceRpcSubmit TxId)
-> TxId -> Either TraceRpcSubmit TxId
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => TxId) -> TxId
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => TxId) -> TxId)
-> (ShelleyBasedEraConstraints era => TxId) -> TxId
forall a b. (a -> b) -> a -> b
$ TxId -> TxId
fromShelleyTxId (Tx TopTx (ShelleyLedgerEra era) -> TxId
forall era (l :: TxLevel). EraTx era => Tx l era -> TxId
L.txIdTx Tx TopTx (ShelleyLedgerEra era)
ledgerTx)
    putTraceThrowEither result

  putTraceThrowEither :: Either e b -> m b
putTraceThrowEither Either e b
v = (HasCallStack => m b) -> m b
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m b) -> m b) -> (HasCallStack => m b) -> m b
forall a b. (a -> b) -> a -> b
$ do
    -- See Cardano.Node.Tracing.Tracers.Rpc in cardano-node for details how this is logged
    (e -> m ()) -> (b -> m ()) -> Either e b -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m ()
forall t' t e (m :: * -> *).
(t ~ TraceRpc, Inject t' t, Has (Tracer m t) e, MonadReader e m) =>
t' -> m ()
putTrace (m () -> b -> m ()
forall a b. a -> b -> a
const (m () -> b -> m ()) -> m () -> b -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Either e b
v
    Either e b -> m b
forall e (m :: * -> *) a.
(Error e, HasCallStack, MonadIO m, Show e, Typeable e) =>
Either e a -> m a
throwEither Either e b
v