DBLayer: Handle case where PutLocalTxSubmission txId does not exist

lib/core/src/Cardano/Wallet.hs

@@ -187,6 +187,7 @@ import Cardano.Slotting.Slot
     ( SlotNo (..) )
 import Cardano.Wallet.DB
     ( DBLayer (..)
+    , ErrNoSuchTransaction (..)
     , ErrNoSuchWallet (..)
     , ErrRemoveTx (..)
     , ErrWalletAlreadyExists (..)
@@ -1695,7 +1696,7 @@ getTransaction ctx wid tid = db & \DBLayer{..} -> do
         Left err -> do
             throwE (ErrGetTransactionNoSuchWallet err)
         Right Nothing -> do
-            let err' = ErrNoSuchTransaction tid
+            let err' = ErrNoSuchTransaction wid tid
             throwE (ErrGetTransactionNoSuchTransaction err')
         Right (Just tx) ->
             pure tx
@@ -2224,10 +2225,6 @@ data ErrGetTransaction
     | ErrGetTransactionNoSuchTransaction ErrNoSuchTransaction
     deriving (Show, Eq)
 
--- | Indicates that the specified transaction hash is not found.
-newtype ErrNoSuchTransaction = ErrNoSuchTransaction (Hash "Tx")
-    deriving (Show, Eq)
-
 -- | Indicates that the specified start time is later than the specified end
 -- time.
 data ErrStartTimeLaterThanEndTime = ErrStartTimeLaterThanEndTime

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -2864,7 +2864,7 @@ instance IsServerError ErrSubmitExternalTx where
 instance IsServerError ErrRemoveTx where
     toServerError = \case
         ErrRemoveTxNoSuchWallet wid -> toServerError wid
-        ErrRemoveTxNoSuchTransaction tid ->
+        ErrRemoveTxNoSuchTransaction (ErrNoSuchTransaction _wid tid) ->
             apiError err404 NoSuchTransaction $ mconcat
                 [ "I couldn't find a transaction with the given id: "
                 , toText tid
@@ -2942,7 +2942,7 @@ instance IsServerError ErrGetTransaction where
 
 instance IsServerError ErrNoSuchTransaction where
     toServerError = \case
-        ErrNoSuchTransaction tid ->
+        ErrNoSuchTransaction _wid tid ->
             apiError err404 NoSuchTransaction $ mconcat
                 [ "I couldn't find a transaction with the given id: "
                 , toText tid

lib/core/src/Cardano/Wallet/DB.hs

@@ -29,9 +29,11 @@ module Cardano.Wallet.DB
     , gapSize
 
       -- * Errors
-    , ErrRemoveTx (..)
     , ErrNoSuchWallet(..)
     , ErrWalletAlreadyExists(..)
+    , ErrNoSuchTransaction (..)
+    , ErrRemoveTx (..)
+    , ErrPutLocalTxSubmission (..)
     ) where
 
 import Prelude
@@ -259,7 +261,7 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
         -> Hash "Tx"
         -> SealedTx
         -> SlotNo
-        -> ExceptT ErrNoSuchWallet stm ()
+        -> ExceptT ErrPutLocalTxSubmission stm ()
         -- ^ Add or update a transaction in the local submission pool with the
         -- most recent submission slot.
 
@@ -334,16 +336,23 @@ newtype ErrNoSuchWallet
     = ErrNoSuchWallet WalletId -- Wallet is gone or doesn't exist yet
     deriving (Eq, Show)
 
+-- | Can't add a transaction to the local tx submission pool.
+data ErrPutLocalTxSubmission
+    = ErrPutLocalTxSubmissionNoSuchWallet ErrNoSuchWallet
+    | ErrPutLocalTxSubmissionNoSuchTransaction ErrNoSuchTransaction
+    deriving (Eq, Show)
+
 -- | Can't remove pending or expired transaction.
 data ErrRemoveTx
     = ErrRemoveTxNoSuchWallet ErrNoSuchWallet
-    | ErrRemoveTxNoSuchTransaction (Hash "Tx")
+    | ErrRemoveTxNoSuchTransaction ErrNoSuchTransaction
     | ErrRemoveTxAlreadyInLedger (Hash "Tx")
     deriving (Eq, Show)
 
--- | Can't perform given operation because there's no transaction
-newtype ErrNoSuchTransaction
-    = ErrNoSuchTransaction (Hash "Tx")
+-- | Indicates that the specified transaction hash is not found in the
+-- transaction history of the given wallet.
+data ErrNoSuchTransaction
+    = ErrNoSuchTransaction WalletId (Hash "Tx")
     deriving (Eq, Show)
 
 -- | Forbidden operation was executed on an already existing wallet

lib/core/src/Cardano/Wallet/DB/MVar.hs

@@ -22,7 +22,9 @@ import Cardano.Address.Derivation
     ( XPrv )
 import Cardano.Wallet.DB
     ( DBLayer (..)
+    , ErrNoSuchTransaction (..)
     , ErrNoSuchWallet (..)
+    , ErrPutLocalTxSubmission (..)
     , ErrRemoveTx (..)
     , ErrWalletAlreadyExists (..)
     , PrimaryKey (..)
@@ -186,7 +188,7 @@ newDBLayer timeInterpreter = do
         -----------------------------------------------------------------------}
 
         , putLocalTxSubmission = \pk txid tx sl -> ExceptT $
-            alterDB errNoSuchWallet db $
+            alterDB (fmap ErrPutLocalTxSubmissionNoSuchWallet . errNoSuchWallet) db $
             mPutLocalTxSubmission pk txid tx sl
 
         , readLocalTxSubmissionPending =
@@ -258,8 +260,8 @@ errNoSuchWallet _ = Nothing
 errCannotRemovePendingTx :: Err (PrimaryKey WalletId) -> Maybe ErrRemoveTx
 errCannotRemovePendingTx (NoSuchWallet (PrimaryKey wid)) =
     Just (ErrRemoveTxNoSuchWallet (ErrNoSuchWallet wid))
-errCannotRemovePendingTx (NoSuchTx _ tid) =
-    Just (ErrRemoveTxNoSuchTransaction tid)
+errCannotRemovePendingTx (NoSuchTx (PrimaryKey wid) tid) =
+    Just (ErrRemoveTxNoSuchTransaction (ErrNoSuchTransaction wid tid))
 errCannotRemovePendingTx (CantRemoveTxInLedger _ tid) =
     Just (ErrRemoveTxAlreadyInLedger tid)
 errCannotRemovePendingTx _ = Nothing

lib/core/src/Cardano/Wallet/DB/Model.hs

@@ -515,16 +515,21 @@ mReadDelegationRewardBalance wid db@(Database wallets _) =
     (Right (maybe minBound rewardAccountBalance $ Map.lookup wid wallets), db)
 
 mPutLocalTxSubmission :: Ord wid => wid -> Hash "Tx" -> SealedTx -> SlotNo -> ModelOp wid s xprv ()
-mPutLocalTxSubmission wid txid tx sl = alterModel wid $ \wal ->
-    ((), wal { submittedTxs = Map.insertWith upsert txid (tx, sl) (submittedTxs wal) })
+mPutLocalTxSubmission wid tid tx sl = alterModelErr wid $ \wal ->
+    case Map.lookup tid (txHistory wal) of
+        Nothing -> (Left (NoSuchTx wid tid), wal)
+        Just _ -> (Right (), insertSubmittedTx wal)
   where
-    upsert (origTx, _) (_, newSl) = (origTx, newSl)
+    insertSubmittedTx wal = wal { submittedTxs = putTx (submittedTxs wal) }
+    putTx = Map.insertWith upsert tid (tx, sl)
+    upsert (_, newSl) (origTx, _) = (origTx, newSl)
 
 mReadLocalTxSubmissionPending
     :: Ord wid
     => wid
     -> ModelOp wid s xprv [LocalTxSubmissionStatus SealedTx]
-mReadLocalTxSubmissionPending wid = readWalletModel wid (\wal -> mapMaybe (getSubmission wal) (pendings wal))
+mReadLocalTxSubmissionPending wid = readWalletModel wid $ \wal ->
+    sortOn (view #txId) $ mapMaybe (getSubmission wal) (pendings wal)
   where
     pendings = mapMaybe getPending . Map.toList . txHistory
 

lib/core/src/Cardano/Wallet/DB/Sqlite.hs

@@ -85,7 +85,9 @@ import Cardano.DB.Sqlite.Delete
 import Cardano.Wallet.DB
     ( DBFactory (..)
     , DBLayer (..)
+    , ErrNoSuchTransaction (..)
     , ErrNoSuchWallet (..)
+    , ErrPutLocalTxSubmission (..)
     , ErrRemoveTx (..)
     , ErrWalletAlreadyExists (..)
     , PrimaryKey (..)
@@ -1521,9 +1523,14 @@ newDBLayerWith cacheBehavior tr ti SqliteContext{runQuery} = do
                     ]
 
         , putLocalTxSubmission = \(PrimaryKey wid) txid tx sl -> ExceptT $ do
+            let errNoSuchWallet = ErrPutLocalTxSubmissionNoSuchWallet $
+                    ErrNoSuchWallet wid
+            let errNoSuchTx = ErrPutLocalTxSubmissionNoSuchTransaction $
+                    ErrNoSuchTransaction wid txid
+
             selectWallet wid >>= \case
-                Nothing -> pure $ Left $ ErrNoSuchWallet wid
-                Just _ -> Right <$> do
+                Nothing -> pure $ Left errNoSuchWallet
+                Just _ -> handleConstraint errNoSuchTx $ do
                     let record = LocalTxSubmission (TxId txid) wid sl tx
                     void $ upsert record [ LocalTxSubmissionLastSlot =. sl ]
 
@@ -1543,7 +1550,8 @@ newDBLayerWith cacheBehavior tr ti SqliteContext{runQuery} = do
             let errNoMorePending =
                     Left $ ErrRemoveTxAlreadyInLedger tid
             let errNoSuchTransaction =
-                    Left $ ErrRemoveTxNoSuchTransaction tid
+                    Left $ ErrRemoveTxNoSuchTransaction $
+                    ErrNoSuchTransaction wid tid
             selectWallet wid >>= \case
                 Nothing -> pure errNoSuchWallet
                 Just _  -> selectTxMeta wid tid >>= \case
@@ -2279,12 +2287,14 @@ listPendingLocalTxSubmissionQuery
     -> SqlPersistT IO [(W.SlotNo, LocalTxSubmission)]
 listPendingLocalTxSubmissionQuery wid = fmap unRaw <$> rawSql query params
   where
+    -- fixme: sort results
     query =
         "SELECT tx_meta.slot,?? " <>
         "FROM tx_meta INNER JOIN local_tx_submission " <>
         "ON tx_meta.wallet_id=local_tx_submission.wallet_id " <>
         "    AND tx_meta.tx_id=local_tx_submission.tx_id " <>
-        "WHERE tx_meta.wallet_id=? AND tx_meta.status=?"
+        "WHERE tx_meta.wallet_id=? AND tx_meta.status=? " <>
+        "ORDER BY local_tx_submission.wallet_id, local_tx_submission.tx_id"
     params = [toPersistValue wid, toPersistValue W.Pending]
     unRaw (Single sl, Entity _ tx) = (sl, tx)
 

lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs

@@ -58,7 +58,9 @@ import Cardano.Address.Derivation
     ( XPrv )
 import Cardano.Wallet.DB
     ( DBLayer (..)
+    , ErrNoSuchTransaction (..)
     , ErrNoSuchWallet (..)
+    , ErrPutLocalTxSubmission (..)
     , ErrRemoveTx (..)
     , ErrWalletAlreadyExists (..)
     , PrimaryKey (..)
@@ -67,7 +69,7 @@ import Cardano.Wallet.DB
 import Cardano.Wallet.DB.Arbitrary
     ( GenState, GenTxHistory (..), InitialCheckpoint (..) )
 import Cardano.Wallet.DB.Model
-    ( Database
+    ( Database (..)
     , Err (..)
     , TxHistory
     , WalletDatabase (..)
@@ -186,7 +188,7 @@ import Data.Map
 import Data.Map.Strict.NonEmptyMap
     ( NonEmptyMap )
 import Data.Maybe
-    ( catMaybes, fromJust, isJust, isNothing )
+    ( catMaybes, fromJust, isJust, isNothing, mapMaybe )
 import Data.Quantity
     ( Percentage (..), Quantity (..) )
 import Data.Set
@@ -504,7 +506,7 @@ runIO db@DBLayer{..} = fmap Resp . go
             catchNoSuchWallet (TxHistory . maybe [] pure) $
             mapExceptT atomically $ getTx (PrimaryKey wid) tid
         PutLocalTxSubmission wid tid sl ->
-            catchNoSuchWallet Unit $
+            catchPutLocalTxSubmission Unit $
             mapExceptT atomically $
             putLocalTxSubmission (PrimaryKey wid) tid (unMockSealedTx tid) sl
         ReadLocalTxSubmissionPending wid ->
@@ -537,21 +539,32 @@ runIO db@DBLayer{..} = fmap Resp . go
         fmap (bimap errNoSuchWallet f) . runExceptT
     catchCannotRemovePendingTx wid f =
         fmap (bimap (errCannotRemovePendingTx wid) f) . runExceptT
+    catchPutLocalTxSubmission f =
+        fmap (bimap errPutLocalTxSubmission f) . runExceptT
 
     errNoSuchWallet :: ErrNoSuchWallet -> Err WalletId
     errNoSuchWallet (ErrNoSuchWallet wid) = NoSuchWallet wid
 
     errWalletAlreadyExists :: ErrWalletAlreadyExists -> Err WalletId
     errWalletAlreadyExists (ErrWalletAlreadyExists wid) = WalletAlreadyExists wid
 
+    errNoSuchTransaction :: ErrNoSuchTransaction -> Err WalletId
+    errNoSuchTransaction (ErrNoSuchTransaction wid tid) = NoSuchTx wid tid
+
     errCannotRemovePendingTx :: WalletId -> ErrRemoveTx -> Err WalletId
     errCannotRemovePendingTx _ (ErrRemoveTxNoSuchWallet e) =
         errNoSuchWallet e
-    errCannotRemovePendingTx wid (ErrRemoveTxNoSuchTransaction tid) =
-        NoSuchTx wid tid
+    errCannotRemovePendingTx _ (ErrRemoveTxNoSuchTransaction e) =
+        errNoSuchTransaction e
     errCannotRemovePendingTx wid (ErrRemoveTxAlreadyInLedger tid) =
         CantRemoveTxInLedger wid tid
 
+    errPutLocalTxSubmission :: ErrPutLocalTxSubmission -> Err WalletId
+    errPutLocalTxSubmission (ErrPutLocalTxSubmissionNoSuchWallet e) =
+        errNoSuchWallet e
+    errPutLocalTxSubmission (ErrPutLocalTxSubmissionNoSuchTransaction e) =
+        errNoSuchTransaction e
+
     unPrimaryKey :: PrimaryKey key -> key
     unPrimaryKey (PrimaryKey key) = key
 
@@ -639,10 +652,13 @@ generator
     :: forall s. (Arbitrary (Wallet s), GenState s)
     => Model s Symbolic
     -> Maybe (Gen (Cmd s :@ Symbolic))
-generator (Model _ wids) = Just $ frequency $ fmap (fmap At) . snd <$> concat
+generator m@(Model _ wids) = Just $ frequency $ fmap (fmap At) . snd <$> concat
     [ generatorWithoutId
     , if null wids then [] else generatorWithWid (fst <$> wids)
+    , if null tids then [] else generatorWithTids tids
     ]
+  where
+    tids = filter (not . null . snd) (txIdsFromModel m)
 
 declareGenerator
     :: String -- ^ A readable name
@@ -699,11 +715,6 @@ generatorWithWid wids =
             <*> genSortOrder
             <*> genRange
             <*> arbitrary
-    -- TODO: Implement mGetTx
-    -- , declareGenerator "GetTx" 3
-    --     $ GetTx <$> genId <*> arbitrary
-    , declareGenerator "PutLocalTxSubmission" 3
-        $ PutLocalTxSubmission <$> genId <*> arbitrary <*> arbitrary
     , declareGenerator "ReadLocalTxSubmissionPending" 3
         $ ReadLocalTxSubmissionPending <$> genId
     , declareGenerator "UpdatePendingTxForExpiry" 4
@@ -741,11 +752,34 @@ generatorWithWid wids =
         , (1, Just <$> arbitrary)
         ]
 
+generatorWithTids
+    :: forall s r. (Arbitrary (Wallet s), GenState s, Eq (Reference WalletId r))
+    => [(Reference WalletId r, [Hash "Tx"])]
+    -> [(String, (Int, Gen (Cmd s (Reference WalletId r))))]
+generatorWithTids tids =
+    [ declareGenerator "PutLocalTxSubmission" 3 genValidPutLocalTxSubmission
+    -- TODO: Implement mGetTx
+    -- , declareGenerator "GetTx" 3
+    --     $ GetTx <$> genId <*> arbitrary
+    ]
+  where
+    -- A valid LocalTxSubmission entry references a TxMeta of the wallet.
+    genValidPutLocalTxSubmission = do
+        wid <- elements (fst <$> tids)
+        tid <- maybe arbitrary elements $ lookup wid tids
+        PutLocalTxSubmission wid tid <$> arbitrary
+
+txIdsFromModel :: Model s r -> [(Reference WalletId r, [Hash "Tx"])]
+txIdsFromModel (Model db widRefs) = mapMaybe getTids widRefs
+  where
+    getTids (widRef, wid) = (widRef,) . Map.keys . txHistory <$>
+        Map.lookup wid (wallets db)
+
 isUnordered :: Ord x => [x] -> Bool
 isUnordered xs = xs /= L.sort xs
 
 shrinker
-    :: (Arbitrary (Wallet s))
+    :: Arbitrary (Wallet s)
     => Cmd s :@ r
     -> [Cmd s :@ r]
 shrinker (At cmd) = case cmd of