resolveFullTx

src/base/lib/Convex/Utils.hs

@@ -17,6 +17,10 @@ module Convex.Utils(
   scriptFromCborV1,
   unsafeScriptFromCborV1,
   scriptAddressV1,
+
+  -- * Transaction inputs
+  requiredTxIns,
+
   -- * Serialised transactions
   txFromCbor,
   unsafeTxFromCbor,
@@ -66,12 +70,14 @@ import           Cardano.Ledger.Crypto                    (StandardCrypto)
 import           Cardano.Slotting.EpochInfo.API           (epochInfoSlotToUTCTime,
                                                            hoistEpochInfo)
 import qualified Cardano.Slotting.Time                    as Time
+import           Control.Lens                             (view)
 import           Control.Monad                            (void, when)
 import           Control.Monad.Except                     (MonadError)
 import           Control.Monad.IO.Class                   (MonadIO (..))
 import           Control.Monad.Result                     (ResultT, throwError)
 import qualified Control.Monad.Result                     as Result
 import           Control.Monad.Trans.Except               (ExceptT, runExceptT)
+import qualified Convex.CardanoApi.Lenses                 as L
 import           Convex.MonadLog                          (MonadLog, logWarnS)
 import           Convex.PlutusLedger.V1                   (transPOSIXTime,
                                                            unTransPOSIXTime)
@@ -302,3 +308,11 @@ alonzoEraUtxo f = case C.alonzoBasedEra @era of
   C.AlonzoEraOnwardsAlonzo  -> f
   C.AlonzoEraOnwardsBabbage -> f
   C.AlonzoEraOnwardsConway  -> f
+
+{-| All 'TxIn's that are required for computing the balance and fees of a transaction
+-}
+requiredTxIns :: C.TxBodyContent v era -> Set C.TxIn
+requiredTxIns body =
+  Set.fromList (fst <$> view L.txIns body)
+  <> Set.fromList (view (L.txInsReference . L.txInsReferenceTxIns) body)
+  <> Set.fromList (view (L.txInsCollateral . L.txInsCollateralTxIns) body)

src/base/lib/Convex/UtxoMod.hs

@@ -101,13 +101,3 @@ data FullTx =
     }
     deriving stock (Eq, Show, Generic)
     -- deriving anyclass (ToJSON, FromJSON)
-
--- {-| Download the full transaction
--- -}
--- -- TODO: Move to blockfrost package
--- resolveTx :: C.TxId -> m FullTx
--- resolveTx = undefined
-
--- 2. Adjust the reference scripts with replaceHash (this effectively changes the StablecoinParams)
-
--- 3. Adjust the script address of the output to match the new script hash

src/blockfrost/convex-blockfrost.cabal

@@ -32,7 +32,6 @@ library
       Convex.Blockfrost
       Convex.Blockfrost.MonadBlockchain
       Convex.Blockfrost.Orphans
-      Convex.Blockfrost.ResolveTx
       Convex.Blockfrost.Types
     build-depends:
       base >= 4.14 && < 5,

src/blockfrost/lib/Convex/Blockfrost.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DerivingStrategies   #-}
 {-# LANGUAGE GADTs                #-}
 {-# LANGUAGE LambdaCase           #-}
+{-# LANGUAGE NamedFieldPuns       #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE TupleSections        #-}
 {-# LANGUAGE TypeApplications     #-}
@@ -13,16 +14,21 @@ module Convex.Blockfrost(
   evalBlockfrostT,
   runBlockfrostT,
   -- * Utility functions
-  streamUtxos
+  streamUtxos,
+
+  -- * Obtaining fully resolved transactions
+  resolveFullTx
 ) where
 
 import qualified Blockfrost.Client                 as Client
 import           Blockfrost.Client.Types           (BlockfrostClientT,
-                                                    BlockfrostError, Project)
+                                                    BlockfrostError,
+                                                    MonadBlockfrost, Project)
 import qualified Blockfrost.Client.Types           as Types
 import qualified Cardano.Api                       as C
 import           Control.Monad                     ((>=>))
-import           Control.Monad.Except              (liftEither, runExceptT)
+import           Control.Monad.Except              (MonadError, liftEither,
+                                                    runExceptT)
 import           Control.Monad.IO.Class            (MonadIO (..))
 import           Control.Monad.State.Strict        (StateT)
 import qualified Control.Monad.State.Strict        as State
@@ -32,6 +38,8 @@ import           Convex.Blockfrost.Orphans         ()
 import qualified Convex.Blockfrost.Types           as Types
 import           Convex.Class                      (MonadBlockchain (..),
                                                     MonadUtxoQuery (..))
+import           Convex.Utils                      (requiredTxIns)
+import           Convex.UtxoMod                    (FullTx (..))
 import qualified Convex.Utxos                      as Utxos
 import           Data.Bifunctor                    (Bifunctor (..))
 import qualified Data.Set                          as Set
@@ -97,3 +105,13 @@ runBlockfrostT state proj =
   Types.runBlockfrostClientT proj
   . flip State.runStateT state
   . unBlockfrostT
+
+{-| Download the full transaction and all of its inputs
+-}
+resolveFullTx :: (MonadBlockfrost m, MonadError Types.DecodingError m) => C.TxId -> m FullTx
+resolveFullTx txId = do
+  ftxTransaction <- Types.resolveTx txId >>= liftEither
+  let (C.Tx (C.TxBody txBodyContent) _witnesses) = ftxTransaction
+  let reqTxIns = requiredTxIns txBodyContent
+  utxo <- State.evalStateT (MonadBlockchain.getUtxoByTxIn reqTxIns) MonadBlockchain.emptyBlockfrostCache
+  pure FullTx{ftxTransaction, ftxInputs = C.unUTxO utxo}

src/blockfrost/lib/Convex/Blockfrost/MonadBlockchain.hs

@@ -50,7 +50,6 @@ import           Control.Lens                                 (Lens', at,
                                                                makeLensesFor,
                                                                use, (.=), (<>=),
                                                                (?=))
-import           Control.Monad.Except                         (runExceptT)
 import           Control.Monad.IO.Class                       (MonadIO (..))
 import           Control.Monad.State                          (MonadState)
 import           Convex.Blockfrost.Orphans                    ()
@@ -185,7 +184,7 @@ sendTxBlockfrost =
 -}
 resolveTxIn :: (MonadBlockfrost m, MonadState BlockfrostCache m) => TxIn -> m (TxOut CtxUTxO ConwayEra)
 resolveTxIn txI@(TxIn txId (C.TxIx txIx)) = getOrRetrieve (txInputs . at txI) $ do
-  utxos <- runExceptT (Client.getTxCBOR (Types.fromTxHash txId) >>= Types.decodeTransactionCBOR)
+  utxos <- Types.resolveTx txId
           -- FIXME: Error handling
           >>= either (error . show) (pure . fmap (second  C.toCtxUTxOTxOut) . txnUtxos)
   txInputs <>= Map.fromList utxos

src/blockfrost/lib/Convex/Blockfrost/Types.hs

@@ -25,7 +25,9 @@ module Convex.Blockfrost.Types(
   addressUtxo,
   addressUtxoTxIn,
   ScriptResolutionFailure(..),
+  DecodingError(..),
   resolveScript,
+  resolveTx,
   -- * Protocol parameters
   protocolParametersConway,
   -- * CBOR
@@ -102,6 +104,7 @@ import           Control.Monad.Except                           (MonadError (..)
                                                                  runExceptT,
                                                                  throwError)
 import           Control.Monad.Trans.Class                      (lift)
+import           Convex.Blockfrost.Orphans                      ()
 import qualified Convex.CardanoApi.Lenses                       as L
 import           Convex.Utils                                   (inBabbage)
 import qualified Data.ByteString.Base16                         as Base16
@@ -278,6 +281,11 @@ decodeScriptCbor tp hsh text =
   either (throwError . ScriptDecodingError tp hsh . Base16DecodeError) pure (Base16.decode $ Text.Encoding.encodeUtf8 text)
   >>= either (throwError . ScriptDecodingError tp hsh . CBORError) pure . C.deserialiseFromCBOR (C.proxyToAsType $ Proxy @(C.Script lang))
 
+{-| Get the transaction from blockfrost
+-}
+resolveTx :: forall era m. (MonadBlockfrost m, C.IsShelleyBasedEra era) => C.TxId -> m (Either DecodingError (C.Tx era))
+resolveTx txId = runExceptT (Client.getTxCBOR (fromTxHash txId) >>= decodeTransactionCBOR)
+
 {-| Load this output's reference script from blockfrost and return the full output
 -}
 resolveScript :: forall era m. (C.IsBabbageBasedEra era, MonadBlockfrost m) => TxOutUnresolvedScript era -> m (Either ScriptResolutionFailure (C.TxOut C.CtxUTxO era))
@@ -351,10 +359,10 @@ toCBORString = CBORString . BSL.fromStrict . C.Ledger.serialize' Version.shelley
 
 {-| Decode a full transaction from a CBOR hex string
 -}
-decodeTransactionCBOR :: MonadError DecodingError m => TransactionCBOR -> m (C.Tx C.ConwayEra)
+decodeTransactionCBOR :: forall era m. (MonadError DecodingError m, C.IsShelleyBasedEra era) => TransactionCBOR -> m (C.Tx era)
 decodeTransactionCBOR TransactionCBOR{_transactionCBORCbor} =
   either (throwError . Base16DecodeError) pure (Base16.decode $ Text.Encoding.encodeUtf8 _transactionCBORCbor)
-  >>= either (throwError . CBORError) pure . C.deserialiseFromCBOR (C.proxyToAsType $ Proxy @(C.Tx C.ConwayEra))
+  >>= either (throwError . CBORError) pure . C.deserialiseFromCBOR (C.proxyToAsType $ Proxy @(C.Tx era))
 
 {-| The 'SystemStart' value
 -}

src/coin-selection/lib/Convex/CoinSelection.hs

@@ -39,7 +39,6 @@ module Convex.CoinSelection(
   signBalancedTxBody,
   -- * Balance changes
   balanceChanges,
-  requiredTxIns,
   spentTxIns,
   -- * Etc.
   prepCSInputs,
@@ -80,7 +79,7 @@ import qualified Convex.BuildTx                as BuildTx
 import qualified Convex.CardanoApi.Lenses      as L
 import           Convex.Class                  (MonadBlockchain (..))
 import           Convex.Utils                  (inAlonzo, inBabbage, inMary,
-                                                mapError)
+                                                mapError, requiredTxIns)
 import           Convex.UTxOCompatibility      (UTxOCompatibility,
                                                 compatibleWith, txCompatibility)
 import           Convex.Utxos                  (BalanceChanges (..),
@@ -835,12 +834,6 @@ spentTxIns (view L.txIns -> inputs) =
   -- TODO: Include collateral etc. fields
   Set.fromList (fst <$> inputs)
 
-requiredTxIns :: C.TxBodyContent v era -> Set C.TxIn
-requiredTxIns body =
-  Set.fromList (fst <$> view L.txIns body)
-  <> Set.fromList (view (L.txInsReference . L.txInsReferenceTxIns) body)
-  <> Set.fromList (view (L.txInsCollateral . L.txInsCollateralTxIns) body)
-
 lookupTxIns :: MonadBlockchain era m => Set C.TxIn -> m (C.UTxO era)
 lookupTxIns = utxoByTxIn