{-# 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 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 -> 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
$ TxBody era -> TxId
forall era. TxBody era -> TxId
getTxId (TxBody era -> TxId) -> TxBody era -> TxId
forall a b. (a -> b) -> a -> b
$ Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx
    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