Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
add getSubmissionsTransactions_ to DBPendingTxs
  • Loading branch information
paolino committed Jan 24, 2023
1 parent d38aeb8 commit d64ea49
Show file tree
Hide file tree
Showing 5 changed files with 54 additions and 9 deletions.
1 change: 1 addition & 0 deletions lib/wallet/cardano-wallet.cabal
Expand Up @@ -234,6 +234,7 @@ library
Cardano.Wallet.DB.Store.Meta.Model
Cardano.Wallet.DB.Store.Meta.Store
Cardano.Wallet.DB.Store.Submissions.Model
Cardano.Wallet.DB.Store.Submissions.New.Layer
Cardano.Wallet.DB.Store.Submissions.New.Operations
Cardano.Wallet.DB.Store.Submissions.Store
Cardano.Wallet.DB.Store.Transactions.Decoration
Expand Down
21 changes: 20 additions & 1 deletion lib/wallet/src/Cardano/Wallet/DB.hs
Expand Up @@ -6,6 +6,7 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}

-- |
-- Copyright: © 2018-2020 IOHK
Expand Down Expand Up @@ -43,6 +44,10 @@ import Prelude

import Cardano.Address.Derivation
( XPrv )
import Cardano.Wallet.DB.Store.Submissions.New.Operations
( SubmissionMeta (..) )
import Cardano.Wallet.DB.Store.Transactions.Decoration
( TxInDecorator )
import Cardano.Wallet.DB.WalletState
( DeltaMap, DeltaWalletState, ErrNoSuchWallet (..) )
import Cardano.Wallet.Primitive.AddressDerivation
Expand Down Expand Up @@ -79,6 +84,10 @@ import Cardano.Wallet.Primitive.Types.Tx
, TxMeta (..)
, TxStatus
)
import Cardano.Wallet.Read.Eras
( EraValue )
import Cardano.Wallet.Submissions.Submissions
( TxStatusMeta )
import Control.Monad.IO.Class
( MonadIO, liftIO )
import Control.Monad.Trans.Except
Expand All @@ -100,8 +109,8 @@ import Data.Word
import UnliftIO.Exception
( Exception )

import qualified Cardano.Wallet.Read.Tx as Read
import qualified Data.Map.Strict as Map

-- | Instantiate database layers at will
data DBFactory m s k = DBFactory
{ withDatabase :: forall a. WalletId -> (DBLayer m s k -> IO a) -> IO a
Expand Down Expand Up @@ -665,6 +674,9 @@ data DBTxHistory stm = DBTxHistory
-- transaction isn't found.
--
-- If the wallet doesn't exist, this operation returns an error.

, mkDecorator_ :: TxInDecorator (EraValue Read.Tx) stm
-- ^ compute TxIn resolutions for the given Tx
}

-- | A database layer for storing pending transactions.
Expand All @@ -688,6 +700,13 @@ data DBPendingTxs stm = DBPendingTxs
--
-- Does nothing if the walletId does not exist.

, getInSubmissionTransactionInfos_
:: WalletId
-> stm [TxStatusMeta SubmissionMeta SlotNo SealedTx]
-- ^ Fetch the current pending transaction set for a known wallet
--
-- Returns an empty list if the wallet isn't found.

, readLocalTxSubmissionPending_
:: WalletId
-> stm [LocalTxSubmissionStatus SealedTx]
Expand Down
16 changes: 14 additions & 2 deletions lib/wallet/src/Cardano/Wallet/DB/Layer.hs
Expand Up @@ -112,7 +112,7 @@ import Cardano.Wallet.DB.Store.Meta.Model
import Cardano.Wallet.DB.Store.Submissions.Model
( TxLocalSubmissionHistory (..) )
import Cardano.Wallet.DB.Store.Transactions.Decoration
( decorateTxInsForRelation )
( TxInDecorator, decorateTxInsForReadTx, decorateTxInsForRelation )
import Cardano.Wallet.DB.Store.Transactions.Model
( TxSet (..) )
import Cardano.Wallet.DB.Store.Transactions.TransactionInfo
Expand All @@ -138,6 +138,8 @@ import Cardano.Wallet.Primitive.Passphrase
( PassphraseHash )
import Cardano.Wallet.Primitive.Slotting
( TimeInterpreter, firstSlotInEpoch, interpretQuery )
import Cardano.Wallet.Read.Eras
( EraValue )
import Control.Exception
( throw )
import Control.Monad
Expand All @@ -153,7 +155,7 @@ import Control.Tracer
import Data.Coerce
( coerce )
import Data.DBVar
( loadDBVar, modifyDBMaybe, readDBVar, updateDBVar )
( DBVar, loadDBVar, modifyDBMaybe, readDBVar, updateDBVar )
import Data.Either
( isRight )
import Data.Foldable
Expand Down Expand Up @@ -218,6 +220,7 @@ import qualified Cardano.Wallet.Primitive.Types as W
import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
import qualified Cardano.Wallet.Primitive.Types.Hash as W
import qualified Cardano.Wallet.Primitive.Types.Tx as W
import qualified Cardano.Wallet.Read.Tx as Read
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
Expand Down Expand Up @@ -719,6 +722,7 @@ newDBLayerWith _cacheBehavior _tr ti SqliteContext{runQuery} = do
txHistory@(txSet,_) <- readDBVar transactionsDBVar
let transactions = lookupTxMeta wid (TxId txid) txHistory
lift $ forM transactions $ selectTransactionInfo ti tip txSet
, mkDecorator_ = mkDecorator transactionsDBVar
}

{-----------------------------------------------------------------------
Expand Down Expand Up @@ -759,6 +763,8 @@ newDBLayerWith _cacheBehavior _tr ti SqliteContext{runQuery} = do
void $ runExceptT $ putLocalTxSubmission_ dbPendingTxs
wid (tx ^. #txId) binary sl

, getInSubmissionTransactionInfos_ = \_ -> pure []

, readLocalTxSubmissionPending_ =
fmap (map localTxSubmissionFromEntity)
. listPendingLocalTxSubmissionQuery
Expand Down Expand Up @@ -816,6 +822,12 @@ newDBLayerWith _cacheBehavior _tr ti SqliteContext{runQuery} = do

pure $ mkDBLayerFromParts ti DBLayerCollection{..}

mkDecorator
:: DBVar (SqlPersistT IO) DeltaTxWalletsHistory
-> TxInDecorator (EraValue Read.Tx) (SqlPersistT IO)
mkDecorator transactionsDBVar tx = do
(txSet,_) <- readDBVar transactionsDBVar
pure $ decorateTxInsForReadTx txSet tx

readWalletMetadata
:: W.WalletId
Expand Down
16 changes: 11 additions & 5 deletions lib/wallet/src/Cardano/Wallet/DB/Store/Submissions/New/Layer.hs
Expand Up @@ -41,7 +41,7 @@ import Cardano.Wallet.Submissions.Submissions
import Cardano.Wallet.Submissions.TxStatus
( TxStatus (..), getTx, status )
import Control.Lens
( (^.) )
( to, (^.), (^..) )
import Control.Monad.Except
( ExceptT (ExceptT) )
import Data.Bifunctor
Expand All @@ -59,7 +59,7 @@ import qualified Data.Map.Strict as Map

-- TODO: This implementation is not completed / fully tested yet.
mkDbPendingTxs
:: DBVar (SqlPersistT IO) (DeltaMap WalletId DeltaTxSubmissions)
:: DBVar (SqlPersistT IO) (DeltaMap WalletId DeltaTxSubmissions) -- ^
-> DBPendingTxs (SqlPersistT IO)
mkDbPendingTxs dbvar = DBPendingTxs
{ putLocalTxSubmission_ = \wid txid tx sl -> do
Expand Down Expand Up @@ -87,10 +87,16 @@ mkDbPendingTxs dbvar = DBPendingTxs
$ AddSubmission expiry (TxId $ tx ^. #txId, sealedTx)
$ submissionMetaFromTxMeta meta resubmitted

, getInSubmissionTransactionInfos_ = \wid -> do
submissions <- readDBVar dbvar
pure $ case Map.lookup wid submissions of
Nothing -> []
Just xs -> xs ^.. transactionsL . traverse . to (fmap snd)

, readLocalTxSubmissionPending_ = \wid -> do
v <- readDBVar dbvar
pure $ case Map.lookup wid v of
Nothing -> [] -- shouldn't we be throwing an exception here ?
Nothing -> []
Just sub -> do
(_k, x) <- Map.assocs $ sub ^. transactionsL
mkLocalTxSubmission x
Expand Down Expand Up @@ -118,10 +124,10 @@ mkDbPendingTxs dbvar = DBPendingTxs
mkLocalTxSubmission
:: TxSubmissionsStatus
-> [LocalTxSubmissionStatus SealedTx]
mkLocalTxSubmission (TxStatusMeta status SubmissionMeta{..})
mkLocalTxSubmission (TxStatusMeta status' SubmissionMeta{..})
= maybe
[]
(\(TxId txId, sealed) -> pure $
LocalTxSubmissionStatus (txId) sealed submissionMetaResubmitted
)
$ getTx status
$ getTx status'
Expand Up @@ -3,6 +3,7 @@
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
Expand All @@ -17,6 +18,7 @@ module Cardano.Wallet.Primitive.Types.Tx.TransactionInfo
( TransactionInfo (..)
, fromTransactionInfo
, toTxHistory
, hasStatus
)
where

Expand All @@ -33,7 +35,7 @@ import Cardano.Wallet.Primitive.Types.Tx.Tx
import Cardano.Wallet.Primitive.Types.Tx.TxIn
( TxIn )
import Cardano.Wallet.Primitive.Types.Tx.TxMeta
( TxMeta )
( TxMeta, TxStatus, status )
import Cardano.Wallet.Primitive.Types.Tx.TxOut
( TxOut )
import Cardano.Wallet.Read.Tx.CBOR
Expand Down Expand Up @@ -105,3 +107,8 @@ fromTransactionInfo info = Tx
-- | Drop time-specific information
toTxHistory :: TransactionInfo -> (Tx, TxMeta)
toTxHistory info = (fromTransactionInfo info, txInfoMeta info)

hasStatus :: TxStatus -> TransactionInfo -> Bool
hasStatus s TransactionInfo{txInfoMeta}
| status txInfoMeta == s = True
| otherwise = False

0 comments on commit d64ea49

Please sign in to comment.