Modify SQLite function putTxs to consider tokens.

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

@@ -81,6 +81,7 @@ import Cardano.Wallet.DB.Sqlite.TH
     , TxIn (..)
     , TxMeta (..)
     , TxOut (..)
+    , TxOutToken (..)
     , TxWithdrawal (..)
     , UTxO (..)
     , Wallet (..)
@@ -764,8 +765,9 @@ newDBLayer trace defaultFieldValues mDatabaseFile ti = do
                 insert_ (mkWalletEntity wid meta)
             when (isRight res) $ do
                 insertCheckpoint wid cp <* writeCache wid (Just cp)
-                let (metas, txins, txouts, ws) = mkTxHistory wid txs
-                putTxs metas txins txouts ws
+                let (metas, txins, txouts, txoutTokens, ws) =
+                        mkTxHistory wid txs
+                putTxs metas txins txouts txoutTokens ws
                 insert_ (mkProtocolParametersEntity wid pp)
             pure res
 
@@ -898,8 +900,9 @@ newDBLayer trace defaultFieldValues mDatabaseFile ti = do
             selectWallet wid >>= \case
                 Nothing -> pure $ Left $ ErrNoSuchWallet wid
                 Just _ -> do
-                    let (metas, txins, txouts, ws) = mkTxHistory wid txs
-                    putTxs metas txins txouts ws
+                    let (metas, txins, txouts, txoutTokens, ws) =
+                            mkTxHistory wid txs
+                    putTxs metas txins txouts txoutTokens ws
                     pure $ Right ()
 
         , readTxHistory = \(PrimaryKey wid) minWithdrawal order range status -> do
@@ -1180,7 +1183,7 @@ checkpointFromEntity cp utxo s =
 mkTxHistory
     :: W.WalletId
     -> [(W.Tx, W.TxMeta)]
-    -> ([TxMeta], [TxIn], [TxOut], [TxWithdrawal])
+    -> ([TxMeta], [TxIn], [TxOut], [TxOutToken], [TxWithdrawal])
 mkTxHistory wid txs = flatTxHistory
     [ ( mkTxMetaEntity wid txid (W.metadata tx) derived
       , mkTxInputsOutputs (txid, tx)
@@ -1192,18 +1195,19 @@ mkTxHistory wid txs = flatTxHistory
   where
     -- | Make flat lists of entities from the result of 'mkTxHistory'.
     flatTxHistory
-        :: [(TxMeta, ([TxIn], [TxOut]), [TxWithdrawal])]
-        -> ([TxMeta], [TxIn], [TxOut], [TxWithdrawal])
+        :: [(TxMeta, ([TxIn], [(TxOut, [TxOutToken])]), [TxWithdrawal])]
+        -> ([TxMeta], [TxIn], [TxOut], [TxOutToken], [TxWithdrawal])
     flatTxHistory entities =
         ( map (\(a,_,_) -> a) entities
         , concatMap (fst . (\(_,b,_) -> b)) entities
-        , concatMap (snd . (\(_,b,_) -> b)) entities
+        , fst <$> concatMap (snd . (\(_,b,_) -> b)) entities
+        , snd =<< concatMap (snd . (\(_,b,_) -> b)) entities
         , concatMap (\(_,_,c) -> c) entities
         )
 
 mkTxInputsOutputs
     :: (W.Hash "Tx", W.Tx)
-    -> ([TxIn], [TxOut])
+    -> ([TxIn], [(TxOut, [TxOutToken])])
 mkTxInputsOutputs tx =
     ( (dist mkTxIn . ordered W.resolvedInputs) tx
     , (dist mkTxOut . ordered W.outputs) tx )
@@ -1215,11 +1219,22 @@ mkTxInputsOutputs tx =
         , txInputSourceIndex = W.inputIx txIn
         , txInputSourceAmount = amt
         }
-    mkTxOut tid (ix, txOut) = TxOut
-        { txOutputTxId = TxId tid
-        , txOutputIndex = ix
-        , txOutputAddress = view #address txOut
-        , txOutputAmount = W.txOutCoin txOut
+    mkTxOut tid (ix, txOut) = (out, tokens)
+      where
+        out = TxOut
+            { txOutputTxId = TxId tid
+            , txOutputIndex = ix
+            , txOutputAddress = view #address txOut
+            , txOutputAmount = W.txOutCoin txOut
+            }
+        tokens = mkTxOutToken tid ix <$>
+            snd (TB.toFlatList $ view #tokens txOut)
+    mkTxOutToken tid ix (TB.AssetId policy token, quantity) = TxOutToken
+        { txOutTokenTxId = TxId tid
+        , txOutTokenTxIndex = ix
+        , txOutTokenPolicyId = policy
+        , txOutTokenName = token
+        , txOutTokenQuantity = quantity
         }
     ordered f = fmap (zip [0..] . f)
     -- | Distribute `a` accross many `b`s using the given function.
@@ -1419,8 +1434,14 @@ updateTxMetas wid filters =
     updateWhere ((TxMetaWalletId ==. wid) : filters)
 
 -- | Insert multiple transactions, removing old instances first.
-putTxs :: [TxMeta] -> [TxIn] -> [TxOut] -> [TxWithdrawal] -> SqlPersistT IO ()
-putTxs metas txins txouts ws = do
+putTxs
+    :: [TxMeta]
+    -> [TxIn]
+    -> [TxOut]
+    -> [TxOutToken]
+    -> [TxWithdrawal]
+    -> SqlPersistT IO ()
+putTxs metas txins txouts txoutTokens ws = do
     dbChunked repsertMany
         [ (TxMetaKey txMetaTxId txMetaWalletId, m)
         | m@TxMeta{..} <- metas]
@@ -1430,6 +1451,15 @@ putTxs metas txins txouts ws = do
     dbChunked repsertMany
         [ (TxOutKey txOutputTxId txOutputIndex, o)
         | o@TxOut{..} <- txouts ]
+    dbChunked repsertMany
+        [ ( TxOutTokenKey
+            txOutTokenTxId
+            txOutTokenTxIndex
+            txOutTokenPolicyId
+            txOutTokenName
+          , o
+          )
+        | o@TxOutToken{..} <- txoutTokens ]
     dbChunked repsertMany
         [ (TxWithdrawalKey txWithdrawalTxId txWithdrawalAccount, w)
         | w@TxWithdrawal{..} <- ws ]