Merge #283

283: Sqlite: add checkpoints and transactions to DBLayer r=KtorZ a=rvl

Relates to issue #154. This PR branch is based on #282.

- Implemented saving and loading of transaction history to SQLite
- Implemented saving and loading of wallet checkpoints to SQLite, including the state for sequential scheme address discovery.

- I haven't made any decision about what to do with internal functions such as the `Wallet` constructor.
- The SqliteSpec testing is a bit light. However, there should be enough implemented for all the DBSpec tests to work. Also I plan to finish the QSM tests tomorrow which should provide even more coverage.
- Cascading deletes are not working with persistent-sqlite, which is annoying.
- DB indexes are missing on some fields. (Needs some custom SQL, can be fixed later)

Co-authored-by: Rodney Lorrimar <rodney.lorrimar@iohk.io>

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

@@ -24,7 +24,7 @@ module Cardano.Wallet.DB.Sqlite.TH where
 import Prelude
 
 import Cardano.Wallet.DB.Sqlite.Types
-    ( TxId, sqlSettings' )
+    ( AddressPoolXPub, TxId, sqlSettings' )
 import Data.Text
     ( Text )
 import Data.Time.Clock
@@ -38,6 +38,7 @@ import GHC.Generics
 import Numeric.Natural
     ( Natural )
 
+import qualified Cardano.Wallet.Primitive.AddressDiscovery as W
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Data.ByteString.Char8 as B8
 
@@ -152,4 +153,71 @@ UTxO                                     sql=utxo
 
     Foreign Checkpoint fk_checkpoint_utxo utxoTableWalletId utxoTableCheckpointSlot
     deriving Show Generic
+
+-- The pending transactions for a wallet checkpoint.
+PendingTx
+
+    -- The wallet checkpoint (wallet_id, slot)
+    pendingTxTableWalletId        W.WalletId  sql=wallet_id
+    pendingTxTableCheckpointSlot  W.SlotId    sql=slot
+
+    -- Transaction TxIn and TxOut
+    pendingTxTableId2             TxId        sql=tx_id
+
+    Primary pendingTxTableWalletId pendingTxTableCheckpointSlot pendingTxTableId2
+    Foreign Checkpoint fk_pending_tx pendingTxTableWalletId pendingTxTableCheckpointSlot
+    deriving Show Generic
+
+-- State for sequential scheme address discovery
+SeqState
+
+    -- The wallet checkpoint (wallet_id, slot)
+    seqStateTableWalletId        W.WalletId  sql=wallet_id
+    seqStateTableCheckpointSlot  W.SlotId    sql=slot
+
+    UniqueSeqState seqStateTableWalletId seqStateTableCheckpointSlot
+    Foreign Checkpoint fk_checkpoint_seq_state seqStateTableWalletId seqStateTableCheckpointSlot
+    deriving Show Generic
+
+-- Address pool attributes.
+AddressPool
+    addressPoolAccountPubKey        AddressPoolXPub
+    addressPoolGap                  W.AddressPoolGap
+
+    deriving Show Generic
+
+-- Mapping of pool addresses to indices.
+AddressPoolIndex
+    indexAddressPool   AddressPoolId
+    indexAddress       W.Address
+    indexNumber        Word32
+
+    deriving Show Generic
+
+-- Sequential address discovery scheme -- internal address pool
+-- associated with state record.
+SeqStateInternalPool
+    seqStateInternalPoolSeqStateId   SeqStateId
+    seqStateInternalPoolAddressPool  AddressPoolId
+    UniqueSeqStateInternalPool seqStateInternalPoolSeqStateId seqStateInternalPoolAddressPool
+    Primary seqStateInternalPoolSeqStateId
+    deriving Show Generic
+
+-- Sequential address discovery scheme -- external address pool
+-- associated with state record.
+SeqStateExternalPool
+    seqStateExternalPoolSeqStateId   SeqStateId
+    seqStateExternalPoolAddressPool  AddressPoolId
+    UniqueSeqStateExternalPool seqStateExternalPoolSeqStateId seqStateExternalPoolAddressPool
+    Primary seqStateExternalPoolSeqStateId
+    deriving Show Generic
+
+-- Sequential address discovery scheme -- pending change indexes
+SeqStatePendingIx
+    seqStatePendingIxSeqStateId     SeqStateId
+    seqStatePendingIxPos            Word32
+    seqStatePendingIxIndex          Word32
+
+    Primary seqStatePendingIxSeqStateId seqStatePendingIxPos
+    deriving Show Generic
 |]

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

@@ -20,6 +20,12 @@ module Cardano.Wallet.DB.Sqlite.Types where
 
 import Prelude
 
+import Cardano.Crypto.Wallet
+    ( XPub )
+import Cardano.Wallet.Primitive.AddressDerivation
+    ( Depth (..), Key, deserializeXPub, serializeXPub )
+import Cardano.Wallet.Primitive.AddressDiscovery
+    ( AddressPoolGap (..), getAddressPoolGap, mkAddressPoolGap )
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
     , Coin (..)
@@ -74,6 +80,7 @@ import Web.HttpApiData
 import Web.PathPieces
     ( PathPiece (..) )
 
+import qualified Data.ByteString.Char8 as B8
 import qualified Data.Text as T
 
 ----------------------------------------------------------------------------
@@ -253,3 +260,34 @@ instance PersistField Address where
 
 instance PersistFieldSql Address where
     sqlType _ = sqlType (Proxy @Text)
+
+----------------------------------------------------------------------------
+-- AddressPoolGap
+
+instance PersistField AddressPoolGap where
+    toPersistValue = toPersistValue . getAddressPoolGap
+    fromPersistValue pv = fromPersistValue >=> mkAddressPoolGap' $ pv
+      where
+        mkAddressPoolGap' :: Word8 -> Either Text AddressPoolGap
+        mkAddressPoolGap' = first msg . mkAddressPoolGap . fromIntegral
+        msg e = T.pack $ "not a valid value: " <> show pv <> ": " <> show e
+
+instance PersistFieldSql AddressPoolGap where
+    sqlType _ = sqlType (Proxy @Word8)
+
+----------------------------------------------------------------------------
+-- XPub for sequential address discovery
+
+newtype AddressPoolXPub = AddressPoolXPub
+    { getAddressPoolXPub :: Key 'AccountK XPub }
+    deriving (Show, Eq, Generic)
+
+instance PersistField AddressPoolXPub where
+    toPersistValue = toPersistValue . serializeXPub . getAddressPoolXPub
+    fromPersistValue pv = fromPersistValue >=> deserializeXPub' $ pv
+      where
+        deserializeXPub' = bimap msg AddressPoolXPub . deserializeXPub
+        msg e = T.pack $ "not a valid XPub: " <> show pv <> ": " <> e
+
+instance PersistFieldSql AddressPoolXPub where
+    sqlType _ = sqlType (Proxy @B8.ByteString)

lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs

@@ -31,7 +31,8 @@ module Cardano.Wallet.Primitive.AddressDerivation
     , getKey
     , Depth (..)
     , Index
-    , getIndex
+      (..) -- fixme: internal constructor
+    -- , getIndex
     , DerivationType (..)
     , publicKey
     , digest

lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery.hs

@@ -45,8 +45,11 @@ module Cardano.Wallet.Primitive.AddressDiscovery
     , mkAddressPool
     , lookupAddress
 
+    , indexedAddresses -- fixme: internal
+
     -- * Pending Change Indexes
     , PendingIxs
+      (..) -- fixme: internal
     , emptyPendingIxs
 
     -- ** State

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

@@ -29,6 +29,7 @@ module Cardano.Wallet.Primitive.Model
     (
     -- * Type
       Wallet
+        (..) -- fixme: internal
 
     -- * Construction & Modification
     , initWallet

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -17,11 +18,31 @@ import Cardano.Wallet.DB
 import Cardano.Wallet.DB.Sqlite
     ( newDBLayer )
 import Cardano.Wallet.DBSpec
-    ( cleanDB )
+    ( DummyTarget, cleanDB )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( encryptPassphrase, unsafeGenerateKeyFromSeed )
+    ( Passphrase (..)
+    , encryptPassphrase
+    , generateKeyFromSeed
+    , unsafeGenerateKeyFromSeed
+    )
+import Cardano.Wallet.Primitive.AddressDiscovery
+    ( SeqState, defaultAddressPoolGap, mkSeqState )
+import Cardano.Wallet.Primitive.Mnemonic
+    ( EntropySize, entropyToBytes, genEntropy )
+import Cardano.Wallet.Primitive.Model
+    ( Wallet, initWallet )
 import Cardano.Wallet.Primitive.Types
-    ( WalletDelegation (..)
+    ( Address (..)
+    , Coin (..)
+    , Direction (..)
+    , Hash (..)
+    , SlotId (..)
+    , Tx (..)
+    , TxIn (..)
+    , TxMeta (TxMeta)
+    , TxOut (..)
+    , TxStatus (..)
+    , WalletDelegation (..)
     , WalletId (..)
     , WalletMetadata (..)
     , WalletName (..)
@@ -36,40 +57,63 @@ import Data.ByteString
     ( ByteString )
 import Data.Coerce
     ( coerce )
+import Data.Quantity
+    ( Quantity (..) )
 import Data.Text.Class
     ( FromText (..) )
 import Data.Time.Clock
     ( getCurrentTime )
+import System.IO.Unsafe
+    ( unsafePerformIO )
 import Test.Hspec
     ( Spec, beforeAll, beforeWith, describe, it, shouldReturn )
 
+import qualified Data.Map as Map
+
 spec :: Spec
-spec = beforeAll (newDBLayer Nothing) $ beforeWith cleanDB $ do
+spec = beforeAll newMemoryDBLayer $ beforeWith cleanDB $ do
     describe "Wallet table" $ do
         it "create and list works" $ \db -> do
-            unsafeRunExceptT $ createWallet db testPk undefined testMetadata
+            unsafeRunExceptT $ createWallet db testPk testCp testMetadata
             listWallets db `shouldReturn` [testPk]
 
         it "create and get meta works" $ \db -> do
             now <- getCurrentTime
             let md = testMetadata { passphraseInfo = Just $ WalletPassphraseInfo now }
-            unsafeRunExceptT $ createWallet db testPk undefined md
+            unsafeRunExceptT $ createWallet db testPk testCp md
             readWalletMeta db testPk `shouldReturn` Just md
 
         it "create twice is handled" $ \db -> do
-            let create' = createWallet db testPk undefined testMetadata
+            let create' = createWallet db testPk testCp testMetadata
             runExceptT create' `shouldReturn` (Right ())
             runExceptT create' `shouldReturn` (Left (ErrWalletAlreadyExists testWid))
 
         it "create and get private key" $ \db -> do
-            unsafeRunExceptT $ createWallet db testPk undefined testMetadata
+            unsafeRunExceptT $ createWallet db testPk testCp testMetadata
             readPrivateKey db testPk `shouldReturn` Nothing
             let Right phr = fromText "aaaaaaaaaa"
                 k = unsafeGenerateKeyFromSeed (coerce phr, coerce phr) phr
             h <- encryptPassphrase phr
             unsafeRunExceptT (putPrivateKey db testPk (k, h))
             readPrivateKey db testPk `shouldReturn` Just (k, h)
 
+        it "put and read tx history" $ \db -> do
+            unsafeRunExceptT $ createWallet db testPk testCp testMetadata
+            runExceptT (putTxHistory db testPk testTxs) `shouldReturn` Right ()
+            readTxHistory db testPk `shouldReturn` testTxs
+
+newMemoryDBLayer :: IO (DBLayer IO (SeqState DummyTarget) DummyTarget)
+newMemoryDBLayer = newDBLayer Nothing
+
+testCp :: Wallet (SeqState DummyTarget) DummyTarget
+testCp = initWallet initDummyState
+
+initDummyState :: SeqState DummyTarget
+initDummyState = mkSeqState (xprv, mempty) defaultAddressPoolGap
+  where
+      bytes = entropyToBytes <$> unsafePerformIO $ genEntropy @(EntropySize 15)
+      xprv = generateKeyFromSeed (Passphrase bytes, mempty) mempty
+
 testMetadata :: WalletMetadata
 testMetadata = WalletMetadata
     { name = WalletName "test wallet"
@@ -83,3 +127,9 @@ testWid = WalletId (hash ("test" :: ByteString))
 
 testPk :: PrimaryKey WalletId
 testPk = PrimaryKey testWid
+
+testTxs :: Map.Map (Hash "Tx") (Tx, TxMeta)
+testTxs = Map.fromList
+    [ (Hash "tx2"
+      , (Tx [TxIn (Hash "tx1") 0] [TxOut (Address "addr") (Coin 1)]
+        , TxMeta InLedger Incoming (SlotId 14 0) (Quantity 1337144))) ]

lib/core/test/unit/Cardano/Wallet/DBSpec.hs

@@ -30,7 +30,13 @@ import Cardano.Wallet.DB
     , PrimaryKey (..)
     )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( Depth (..), Key, Passphrase (..), XPrv, generateKeyFromSeed )
+    ( Depth (..)
+    , Key
+    , KeyToAddress (..)
+    , Passphrase (..)
+    , XPrv
+    , generateKeyFromSeed
+    )
 import Cardano.Wallet.Primitive.AddressDiscovery
     ( IsOurs (..) )
 import Cardano.Wallet.Primitive.Model
@@ -150,6 +156,9 @@ data DummyTarget
 instance TxId DummyTarget where
     txId = Hash . B8.pack . show
 
+instance KeyToAddress DummyTarget where
+    keyToAddress _ = Address ""
+
 instance Arbitrary (PrimaryKey WalletId) where
     shrink _ = []
     arbitrary = do