diff --git a/cardano-rpc/cardano-rpc.cabal b/cardano-rpc/cardano-rpc.cabal index 3162d42a76..97e10e4e34 100644 --- a/cardano-rpc/cardano-rpc.cabal +++ b/cardano-rpc/cardano-rpc.cabal @@ -55,12 +55,14 @@ library Cardano.Rpc.Client Cardano.Rpc.Proto.Api.Node Cardano.Rpc.Proto.Api.UtxoRpc.Query + Cardano.Rpc.Proto.Api.UtxoRpc.Submit Cardano.Rpc.Server Cardano.Rpc.Server.Config Cardano.Rpc.Server.Internal.Env Cardano.Rpc.Server.Internal.Error Cardano.Rpc.Server.Internal.Monad Cardano.Rpc.Server.Internal.UtxoRpc.Query + Cardano.Rpc.Server.Internal.UtxoRpc.Submit Cardano.Rpc.Server.Internal.UtxoRpc.Type Proto.Cardano.Rpc.Node Proto.Cardano.Rpc.Node_Fields @@ -68,6 +70,8 @@ library Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields Proto.Utxorpc.V1alpha.Query.Query Proto.Utxorpc.V1alpha.Query.Query_Fields + Proto.Utxorpc.V1alpha.Submit.Submit + Proto.Utxorpc.V1alpha.Submit.Submit_Fields other-modules: Cardano.Rpc.Server.Internal.Orphans @@ -81,6 +85,8 @@ library Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields Proto.Utxorpc.V1alpha.Query.Query Proto.Utxorpc.V1alpha.Query.Query_Fields + Proto.Utxorpc.V1alpha.Submit.Submit + Proto.Utxorpc.V1alpha.Submit.Submit_Fields build-depends: base, diff --git a/cardano-rpc/proto/utxorpc/v1alpha/submit/submit.proto b/cardano-rpc/proto/utxorpc/v1alpha/submit/submit.proto new file mode 100644 index 0000000000..b9ceb10163 --- /dev/null +++ b/cardano-rpc/proto/utxorpc/v1alpha/submit/submit.proto @@ -0,0 +1,34 @@ +syntax = "proto3"; + +package utxorpc.v1alpha.submit; + +// Represents a transaction from any supported blockchain. +message AnyChainTx { + oneof type { + bytes raw = 1; // Raw transaction data. + } +} + +// Request to submit transactions to the blockchain. +message SubmitTxRequest { + repeated AnyChainTx tx = 1; // List of transactions to submit. +} + +// TODO u5c: new type +message TxSubmitResult { + oneof result { + bytes ref = 1; // Transaction references. + string error_message = 2; // The error message + } +} + +// Response containing references to the submitted transactions. +// TODO u5c: changed type +message SubmitTxResponse { + repeated TxSubmitResult results = 1; // List of either transaction references or error messages. +} + +// Service definition for submitting transactions and checking their status. +service SubmitService { + rpc SubmitTx(SubmitTxRequest) returns (SubmitTxResponse); // Submit transactions to the blockchain. +} diff --git a/cardano-rpc/src/Cardano/Rpc/Proto/Api/UtxoRpc/Submit.hs b/cardano-rpc/src/Cardano/Rpc/Proto/Api/UtxoRpc/Submit.hs new file mode 100644 index 0000000000..5cc0f15cdb --- /dev/null +++ b/cardano-rpc/src/Cardano/Rpc/Proto/Api/UtxoRpc/Submit.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Cardano.Rpc.Proto.Api.UtxoRpc.Submit + ( module Proto.Utxorpc.V1alpha.Submit.Submit + , module Proto.Utxorpc.V1alpha.Submit.Submit_Fields + ) +where + +import Network.GRPC.Common +import Network.GRPC.Common.Protobuf + +import Proto.Utxorpc.V1alpha.Submit.Submit +import Proto.Utxorpc.V1alpha.Submit.Submit_Fields + +type instance RequestMetadata (Protobuf SubmitService meth) = NoMetadata + +type instance ResponseInitialMetadata (Protobuf SubmitService meth) = NoMetadata + +type instance ResponseTrailingMetadata (Protobuf SubmitService meth) = NoMetadata diff --git a/cardano-rpc/src/Cardano/Rpc/Server.hs b/cardano-rpc/src/Cardano/Rpc/Server.hs index a3bfd6aac4..a75cc7d04b 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server.hs @@ -17,11 +17,13 @@ where import Cardano.Api import Cardano.Rpc.Proto.Api.Node qualified as Rpc import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc +import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as UtxoRpc import Cardano.Rpc.Server.Config import Cardano.Rpc.Server.Internal.Env import Cardano.Rpc.Server.Internal.Monad import Cardano.Rpc.Server.Internal.Orphans () import Cardano.Rpc.Server.Internal.UtxoRpc.Query +import Cardano.Rpc.Server.Internal.UtxoRpc.Submit import RIO @@ -60,6 +62,12 @@ methodsUtxoRpc = . Method (mkNonStreaming readUtxosMethod) $ NoMoreMethods +methodsUtxoRpcSubmit + :: MonadRpc e m + => Methods m (ProtobufMethodsOf UtxoRpc.SubmitService) +methodsUtxoRpcSubmit = + Method (mkNonStreaming submitTxMethod) NoMoreMethods + runRpcServer :: Tracer IO String -> IO (RpcConfig, NetworkMagic) @@ -97,6 +105,7 @@ runRpcServer tracer loadRpcConfig = handleFatalExceptions $ do mconcat [ fromMethods methodsNodeRpc , fromMethods methodsUtxoRpc + , fromMethods methodsUtxoRpcSubmit ] where serverParams :: ServerParams diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Submit.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Submit.hs new file mode 100644 index 0000000000..893c8710bc --- /dev/null +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Submit.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} + +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 RIO hiding (toList) + +import Data.Default +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) +-- ^ A list of succeeded transaction ids or errors for failed ones +submitTxMethod req = do + -- index transactions in the request + let serialisedTxs = zip @Int [0 ..] $ req ^.. #tx . traverse . #raw + + nodeConnInfo <- grab + AnyCardanoEra era <- liftIO . throwExceptT $ determineEra nodeConnInfo + eon <- forEraInEon era (error "Minimum Shelley era required") pure + + -- try to submit each one consecutively + submitResults <- forM serialisedTxs $ \(i, txBytes) -> do + let eTx = + first (("Failed to decode transaction with index " <> show i <> ": ") <>) $ + deserialiseTx eon txBytes + + eTxId <- + fmap join . forM eTx $ + fmap + ( first + ( ("Failed to submit transaction with index " <> show i <> ": ") + <> + ) + ) + . submitTx eon + + pure $ case eTxId of + Left err -> def & #errorMessage .~ fromString err + Right txId' -> def & #ref .~ serialiseToRawBytes txId' + + pure $ def & #results .~ submitResults + where + deserialiseTx :: ShelleyBasedEra era -> ByteString -> Either String (Tx era) + deserialiseTx sbe = shelleyBasedEraConstraints sbe $ first show . deserialiseFromCBOR asType + + submitTx + :: MonadRpc e m + => ShelleyBasedEra era + -> Tx era + -> m (Either String TxId) + submitTx sbe tx = do + nodeConnInfo <- grab + eRes <- + tryAny $ + submitTxToNodeLocal nodeConnInfo (TxInMode sbe tx) >>= \case + Net.Tx.SubmitFail reason -> pure . Left $ show reason + Net.Tx.SubmitSuccess -> pure $ Right . getTxId $ getTxBody tx + case eRes of + Left err -> do + let errString = displayException err + putTrace $ "N2C connection error while trying to submit a transaction: " <> errString + pure $ Left errString + Right res -> pure res