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

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

import Cardano.Api
import Cardano.Api.Network.IPC qualified as Net.Tx
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 ^. #tx . #raw

  txId' <- submitTx eon tx

  pure $ def & #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
    putTraceThrowEither . join . first TraceRpcSubmitN2cConnectionError
      =<< tryAny
        ( submitTxToNodeLocal nodeConnInfo (TxInMode sbe tx) >>= \case
            Net.Tx.SubmitFail TxValidationErrorInCardanoMode
reason -> Either TraceRpcSubmit TxId -> m (Either TraceRpcSubmit TxId)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TraceRpcSubmit TxId -> m (Either TraceRpcSubmit TxId))
-> (TraceRpcSubmit -> Either TraceRpcSubmit TxId)
-> TraceRpcSubmit
-> m (Either TraceRpcSubmit TxId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceRpcSubmit -> Either TraceRpcSubmit TxId
forall a b. a -> Either a b
Left (TraceRpcSubmit -> m (Either TraceRpcSubmit TxId))
-> TraceRpcSubmit -> m (Either TraceRpcSubmit TxId)
forall a b. (a -> b) -> a -> b
$ TxValidationErrorInCardanoMode -> TraceRpcSubmit
TraceRpcSubmitTxValidationError TxValidationErrorInCardanoMode
reason
            SubmitResult TxValidationErrorInCardanoMode
Net.Tx.SubmitSuccess -> Either TraceRpcSubmit TxId -> m (Either TraceRpcSubmit TxId)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TraceRpcSubmit TxId -> m (Either TraceRpcSubmit TxId))
-> (TxId -> Either TraceRpcSubmit TxId)
-> TxId
-> m (Either TraceRpcSubmit TxId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> Either TraceRpcSubmit TxId
forall a b. b -> Either a b
Right (TxId -> m (Either TraceRpcSubmit TxId))
-> TxId -> m (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 :: 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