Skip to content
Permalink
Browse files

Sqlite: start implementing sequential address state tables

  • Loading branch information...
rvl committed May 16, 2019
1 parent a6430da commit d367791d0cac5b339f57b447758f538923a9b0aa
Showing with 80 additions and 9 deletions.
  1. +64 −9 lib/core/src/Cardano/Wallet/DB/Sqlite.hs
  2. +16 −0 lib/core/src/Cardano/Wallet/DB/SqliteTypes.hs
@@ -77,6 +77,7 @@ import Database.Persist.Sql
( LogFunc
, SelectOpt (..)
, Update (..)
, deleteCascadeWhere
, deleteWhere
, deleteWhereCount
, entityVal
@@ -107,6 +108,7 @@ import System.IO
import System.Log.FastLogger
( fromLogStr )

import qualified Cardano.Wallet.Primitive.AddressDiscovery as W
import qualified Cardano.Wallet.Primitive.Model as W
import qualified Cardano.Wallet.Primitive.Types as W
import qualified Data.ByteString.Char8 as B8
@@ -244,9 +246,58 @@ PendingTx

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

Foreign Checkpoint fk_checkpoint_seq_state seqStateTableWalletId seqStateTableCheckpointSlot
deriving Show Generic

-- Address pool attributes.
AddressPool
addressPoolAccountPubKey B8.ByteString
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
deriving Show Generic

-- Sequential address discovery scheme -- external address pool
-- associated with state record.
SeqStateExternalPool
seqStateExternalPoolSeqStateId SeqStateId
seqStateExternalPoolAddressPool AddressPoolId
UniqueSeqStateExternalPool seqStateExternalPoolSeqStateId seqStateExternalPoolAddressPool
deriving Show Generic

-- Sequential address discovery scheme -- pending indexes
SeqStatePendingIx
seqStatePendingIxSeqStateId SeqStateId
seqStatePendingIxIndex Word32

deriving Show Generic
|]


----------------------------------------------------------------------------
-- Sqlite connection set up

@@ -308,7 +359,7 @@ newDBLayer fp = do
Just _ ->
pure $ Left $ ErrWalletAlreadyExists wid
Nothing -> Right <$> do
insert_ (mkWalletEntity wid (toEnum $ addressScheme cp))
insert_ (mkWalletEntity wid meta (Proxy :: Proxy s))
insertCheckpoint wid cp

, removeWallet = \(PrimaryKey wid) ->
@@ -327,7 +378,7 @@ newDBLayer fp = do

, putCheckpoint = \(PrimaryKey wid) cp ->
ExceptT $ unsafeRunQuery conn $ Right <$> do
deleteCheckpoints wid -- clear out all checkpoints
deleteCheckpoints wid (Proxy :: Proxy s) -- clear out all checkpoints
deleteLooseTransactions wid -- clear transactions
insertCheckpoint wid cp -- add this checkpoint

@@ -338,7 +389,8 @@ newDBLayer fp = do
utxo <- selectUTxO cp
pendings <- selectPending cp
(ins, outs) <- selectTxs pendings
pure $ Just $ checkpointFromEntity cp utxo ins outs
s <- selectState (checkpointId cp)
pure (checkpointFromEntity cp utxo ins outs <$> s)
Nothing -> pure Nothing

{-----------------------------------------------------------------------
@@ -412,7 +464,7 @@ delegationFromText :: Maybe Text -> W.WalletDelegation W.PoolId
delegationFromText Nothing = W.NotDelegating
delegationFromText (Just pool) = W.Delegating (W.PoolId pool)

mkWalletEntity :: W.WalletId -> W.WalletMetadata -> AddressScheme -> Wallet
mkWalletEntity :: PersistState s => W.WalletId -> W.WalletMetadata -> Proxy s -> Wallet
mkWalletEntity wid meta s = Wallet
{ walTableId = wid
, walTableName = meta ^. #name . coerce
@@ -421,7 +473,7 @@ mkWalletEntity wid meta s = Wallet
Just (W.WalletPassphraseInfo passInfo) -> Just passInfo
, walTableStatus = meta ^. #status
, walTableDelegation = delegationToText $ meta ^. #delegation
, walTableAddressScheme = s
, walTableAddressScheme = addressScheme s
}

mkWalletMetadataUpdate :: W.WalletMetadata -> [Update Wallet]
@@ -519,8 +571,9 @@ checkpointFromEntity
-> [UTxO]
-> [TxIn]
-> [TxOut]
-> s
-> W.Wallet s t
checkpointFromEntity (Checkpoint _ tip) utxo ins outs =
checkpointFromEntity (Checkpoint _ tip) utxo ins outs s =
W.Wallet utxo' pending tip s
where
utxo' = W.UTxO . Map.fromList $
@@ -537,7 +590,6 @@ checkpointFromEntity (Checkpoint _ tip) utxo ins outs =
lookupTx txid = map snd . filter ((== txid) . fst)
-- fixme: sorting not necessary if db query was ordered
ordered = map snd . sortOn fst
s = error "fixme: implement wallet state in sqlite"

mkTxHistory
:: W.WalletId
@@ -623,16 +675,19 @@ insertCheckpoint wid cp = do
insertMany_ outs
insertMany_ pendings
insertMany_ utxo
insertState (wid, W.currentTip cp) (W.getState cp)

-- | Delete all checkpoints associated with a wallet.
deleteCheckpoints
:: MonadIO m
:: (MonadIO m, PersistState s)
=> W.WalletId
-> Proxy s
-> ReaderT SqlBackend m ()
deleteCheckpoints wid = do
deleteCheckpoints wid s = do
deleteWhere [UtxoTableWalletId ==. wid]
deleteWhere [PendingTxTableWalletId ==. wid]
deleteWhere [CheckpointTableWalletId ==. wid]
deleteState s wid

-- | Delete transactions that belong to a wallet and aren't referred to by
-- either Pending or TxMeta.
@@ -8,6 +8,8 @@ module Cardano.Wallet.DB.SqliteTypes where

import Prelude

import Cardano.Wallet.Primitive.AddressDiscovery
( AddressPoolGap (..), getAddressPoolGap, mkAddressPoolGap )
import Cardano.Wallet.Primitive.Types
( Address (..)
, Coin (..)
@@ -266,3 +268,17 @@ 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)

0 comments on commit d367791

Please sign in to comment.
You can’t perform that action at this time.