Implement load of DeltaUTxOStore.

cardano-foundation · Mar 17, 2023 · 1b389ad · 1b389ad
1 parent 1a3c4d3
commit 1b389ad
Showing 1 changed file with 116 additions and 8 deletions.
diff --git a/lib/wallet/src/Cardano/Wallet/DB/Store/DeltaUTxO/Store.hs b/lib/wallet/src/Cardano/Wallet/DB/Store/DeltaUTxO/Store.hs
@@ -1,31 +1,139 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Cardano.Wallet.DB.Store.DeltaUTxO.Store 
+module Cardano.Wallet.DB.Store.DeltaUTxO.Store
     ( mkStoreUTxOHistory
-    ) where
+    )
+where
 
 import Prelude
 
+import Cardano.Wallet.DB.Sqlite.Schema
+    ( DeltaUTxOSlots (..), DeltaUTxOValue (..), EntityField (..) )
+import Cardano.Wallet.DB.Sqlite.Types
+    ( getTxId )
 import Cardano.Wallet.DB.Store.DeltaUTxO.Model
-    ( DeltaUTxOHistory (..), UTxOHistory (..) )
+    ( DeltaUTxOHistory (..), Spent (..) )
+import Cardano.Wallet.DB.Store.DeltaUTxO.Model.Internal
+    ( UTxOHistory (..) )
+import Cardano.Wallet.DB.Store.DeltaUTxO.TxOutCBOR
+    ( deserializeTxOut )
 import Cardano.Wallet.Primitive.Types
     ( WalletId )
+import Cardano.Wallet.Primitive.Types.Tx.TxIn
+    ( TxIn (TxIn) )
+import Cardano.Wallet.Primitive.Types.UTxO
+    ( UTxO (..) )
+import Control.Lens
+    ( lazy, view, (<&>) )
 import Data.DBVar
     ( Store (..) )
+import Data.Either.Extra
+    ( eitherToMaybe, maybeToEither )
+import Data.Foldable
+    ( foldl' )
 import Database.Persist.Sql
-    ( SqlPersistT )
+    ( SqlPersistT, entityVal, selectFirst, selectList, (==.) )
 import GHC.Exception
-    ( SomeException )
+    ( Exception, SomeException )
+import GHC.Exception.Type
+    ( toException )
+
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 
 -- | Create a 'Store' for 'UTxOHistory' using the given 'WalletId' as a key.
 mkStoreUTxOHistory
     :: WalletId
     -> Store (SqlPersistT IO) DeltaUTxOHistory
-mkStoreUTxOHistory wid = Store
-    { loadS = load wid, writeS = write wid, updateS = update wid }
+mkStoreUTxOHistory wid =
+    Store
+        { loadS = load wid
+        , writeS = write wid
+        , updateS = update wid
+        }
+
+-- | Issues with UTxOHistory operations.
+data UTxOHistoryError
+    = UTxOHistoryNotFound WalletId
+    | UTxOHistoryNotDeserializationError WalletId
+    deriving (Show, Eq, Exception)
 
 load :: WalletId -> SqlPersistT IO (Either SomeException UTxOHistory)
-load _wid = undefined
+load wid = do
+    slots :: Maybe DeltaUTxOSlots <-
+        fmap entityVal
+            <$> selectFirst [DeltaUTxOSlotsWallet ==. wid] []
+    case slots of
+        Nothing -> pure $ Left $ toException $ UTxOHistoryNotFound wid
+        Just DeltaUTxOSlots{deltaUTxOSlotsTip, deltaUTxOSlotsFinality} -> do
+            xs <-
+                fmap entityVal
+                    <$> selectList [DeltaUTxOValueWalletId ==. wid] []
+            pure
+                $ maybeToEither
+                    (toException $ UTxOHistoryNotDeserializationError wid)
+                $ foldl'
+                    patchByRow
+                    ( Just $
+                        UTxOHistory
+                            mempty
+                            mempty
+                            mempty
+                            mempty
+                            deltaUTxOSlotsTip
+                            deltaUTxOSlotsFinality
+                    )
+                    xs
+
+patchByRow :: Maybe UTxOHistory -> DeltaUTxOValue -> Maybe UTxOHistory
+patchByRow Nothing _ = Nothing
+patchByRow
+    ( Just
+            UTxOHistory
+                { history
+                , creationSlots
+                , spentSlots
+                , spentTxIns
+                , finality
+                , tip
+                }
+        )
+    DeltaUTxOValue
+        { deltaUTxOValueTxInTx
+        , deltaUTxOValueTxInIx
+        , deltaUTxOValueTxOut
+        , deltaUTxOValueCreation
+        , deltaUTxOValueSpent
+        } =
+        decodeTxOut deltaUTxOValueTxOut <&> \txOut ->
+            UTxOHistory
+                { history = history <> UTxO (Map.singleton txIn txOut)
+                , creationSlots =
+                    Map.insertWith
+                        (<>)
+                        deltaUTxOValueCreation
+                        txInSingleton
+                        creationSlots
+                , spentSlots = case deltaUTxOValueSpent of
+                    Unspent -> spentSlots
+                    Spent slot ->
+                        Map.insertWith
+                            (<>)
+                            slot
+                            txInSingleton
+                            spentSlots
+                , spentTxIns = case deltaUTxOValueSpent of
+                    Unspent -> spentTxIns
+                    Spent slot -> Map.insert txIn slot spentTxIns
+                , tip
+                , finality
+                }
+      where
+        txIn = TxIn (getTxId deltaUTxOValueTxInTx) deltaUTxOValueTxInIx
+        txInSingleton = Set.singleton txIn
+        decodeTxOut = eitherToMaybe . deserializeTxOut . view lazy
 
 write :: WalletId -> UTxOHistory -> SqlPersistT IO ()
 write _wid = undefined