Migrate to Esqueleto
This commit is contained in:
parent
a36de0a307
commit
5ce822e52f
5 changed files with 233 additions and 53 deletions
|
@ -163,5 +163,10 @@ createWalletAddress n i zNet scope za = do
|
|||
syncWallet ::
|
||||
T.Text -- ^ The database path
|
||||
-> Entity ZcashWallet
|
||||
-> IO ()
|
||||
syncWallet walletDb w = undefined
|
||||
-> IO String
|
||||
syncWallet walletDb w = do
|
||||
accs <- getAccounts walletDb $ entityKey w
|
||||
addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs
|
||||
lastBlock <- getMaxWalletBlock walletDb
|
||||
trNotes <- mapM (findTransparentNotes walletDb lastBlock . entityVal) addrs
|
||||
return $ show trNotes
|
||||
|
|
260
src/Zenith/DB.hs
260
src/Zenith/DB.hs
|
@ -14,19 +14,27 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Zenith.DB where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.HexString
|
||||
import Data.Maybe (fromJust, isJust)
|
||||
import qualified Data.Text as T
|
||||
import Database.Persist
|
||||
import Database.Persist.Sqlite
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import Database.Esqueleto.Experimental
|
||||
import qualified Database.Persist as P
|
||||
import qualified Database.Persist.Sqlite as PS
|
||||
import Database.Persist.TH
|
||||
import Haskoin.Transaction.Common (TxOut(..))
|
||||
import Haskoin.Transaction.Common
|
||||
( OutPoint(..)
|
||||
, TxIn(..)
|
||||
, TxOut(..)
|
||||
, txHashToHex
|
||||
)
|
||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||
import ZcashHaskell.Types
|
||||
( OrchardAction(..)
|
||||
, OrchardBundle(..)
|
||||
|
@ -35,7 +43,9 @@ import ZcashHaskell.Types
|
|||
, ShieldedOutput(..)
|
||||
, ShieldedSpend(..)
|
||||
, Transaction(..)
|
||||
, TransparentAddress(..)
|
||||
, TransparentBundle(..)
|
||||
, UnifiedAddress(..)
|
||||
, ZcashNet
|
||||
)
|
||||
import Zenith.Types
|
||||
|
@ -83,6 +93,7 @@ share
|
|||
block Int
|
||||
conf Int
|
||||
time Int
|
||||
UniqueWTx txId
|
||||
deriving Show Eq
|
||||
WalletTrNote
|
||||
tx WalletTransactionId
|
||||
|
@ -99,6 +110,7 @@ share
|
|||
memo T.Text
|
||||
rawId ShieldOutputId
|
||||
spent Bool
|
||||
nullifier HexStringDB
|
||||
deriving Show Eq
|
||||
WalletOrchNote
|
||||
tx WalletTransactionId
|
||||
|
@ -108,6 +120,7 @@ share
|
|||
memo T.Text
|
||||
rawId OrchActionId
|
||||
spent Bool
|
||||
nullifier HexStringDB
|
||||
deriving Show Eq
|
||||
ZcashTransaction
|
||||
block Int
|
||||
|
@ -119,6 +132,18 @@ share
|
|||
tx ZcashTransactionId
|
||||
value Int
|
||||
script BS.ByteString
|
||||
position Int
|
||||
UniqueTNPos tx position
|
||||
deriving Show Eq
|
||||
TransparentSpend
|
||||
tx ZcashTransactionId
|
||||
outPointHash HexStringDB
|
||||
outPointIndex Int
|
||||
script BS.ByteString
|
||||
seq Int
|
||||
position Int
|
||||
UniqueTSPos tx position
|
||||
deriving Show Eq
|
||||
OrchAction
|
||||
tx ZcashTransactionId
|
||||
nf HexStringDB
|
||||
|
@ -129,6 +154,8 @@ share
|
|||
outCipher HexStringDB
|
||||
cv HexStringDB
|
||||
auth HexStringDB
|
||||
position Int
|
||||
UniqueOAPos tx position
|
||||
deriving Show Eq
|
||||
ShieldOutput
|
||||
tx ZcashTransactionId
|
||||
|
@ -138,6 +165,8 @@ share
|
|||
encCipher HexStringDB
|
||||
outCipher HexStringDB
|
||||
proof HexStringDB
|
||||
position Int
|
||||
UniqueSOPos tx position
|
||||
deriving Show Eq
|
||||
ShieldSpend
|
||||
tx ZcashTransactionId
|
||||
|
@ -147,6 +176,8 @@ share
|
|||
rk HexStringDB
|
||||
proof HexStringDB
|
||||
authSig HexStringDB
|
||||
position Int
|
||||
UniqueSSPos tx position
|
||||
deriving Show Eq
|
||||
|]
|
||||
|
||||
|
@ -156,26 +187,35 @@ initDb ::
|
|||
T.Text -- ^ The database path to check
|
||||
-> IO ()
|
||||
initDb dbName = do
|
||||
runSqlite dbName $ do runMigration migrateAll
|
||||
PS.runSqlite dbName $ do runMigration migrateAll
|
||||
|
||||
-- | Get existing wallets from database
|
||||
getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
|
||||
getWallets dbFp n =
|
||||
runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] []
|
||||
PS.runSqlite dbFp $
|
||||
select $ do
|
||||
wallets <- from $ table @ZcashWallet
|
||||
where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n))
|
||||
pure wallets
|
||||
|
||||
-- | Save a new wallet to the database
|
||||
saveWallet ::
|
||||
T.Text -- ^ The database path to use
|
||||
-> ZcashWallet -- ^ The wallet to add to the database
|
||||
-> IO (Maybe (Entity ZcashWallet))
|
||||
saveWallet dbFp w = runSqlite dbFp $ insertUniqueEntity w
|
||||
saveWallet dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w
|
||||
|
||||
-- | Returns a list of accounts associated with the given wallet
|
||||
getAccounts ::
|
||||
T.Text -- ^ The database path
|
||||
-> ZcashWalletId -- ^ The wallet ID to check
|
||||
-> IO [Entity ZcashAccount]
|
||||
getAccounts dbFp w = runSqlite dbFp $ selectList [ZcashAccountWalletId ==. w] []
|
||||
getAccounts dbFp w =
|
||||
PS.runSqlite dbFp $
|
||||
select $ do
|
||||
accs <- from $ table @ZcashAccount
|
||||
where_ (accs ^. ZcashAccountWalletId ==. val w)
|
||||
pure accs
|
||||
|
||||
-- | Returns the largest account index for the given wallet
|
||||
getMaxAccount ::
|
||||
|
@ -184,8 +224,12 @@ getMaxAccount ::
|
|||
-> IO Int
|
||||
getMaxAccount dbFp w = do
|
||||
a <-
|
||||
runSqlite dbFp $
|
||||
selectFirst [ZcashAccountWalletId ==. w] [Desc ZcashAccountIndex]
|
||||
PS.runSqlite dbFp $
|
||||
selectOne $ do
|
||||
accs <- from $ table @ZcashAccount
|
||||
where_ (accs ^. ZcashAccountWalletId ==. val w)
|
||||
orderBy [desc $ accs ^. ZcashAccountIndex]
|
||||
pure accs
|
||||
case a of
|
||||
Nothing -> return $ -1
|
||||
Just x -> return $ zcashAccountIndex $ entityVal x
|
||||
|
@ -195,7 +239,7 @@ saveAccount ::
|
|||
T.Text -- ^ The database path
|
||||
-> ZcashAccount -- ^ The account to add to the database
|
||||
-> IO (Maybe (Entity ZcashAccount))
|
||||
saveAccount dbFp a = runSqlite dbFp $ insertUniqueEntity a
|
||||
saveAccount dbFp a = PS.runSqlite dbFp $ insertUniqueEntity a
|
||||
|
||||
-- | Returns the largest block in storage
|
||||
getMaxBlock ::
|
||||
|
@ -203,34 +247,38 @@ getMaxBlock ::
|
|||
-> IO Int
|
||||
getMaxBlock dbPath = do
|
||||
b <-
|
||||
runSqlite dbPath $
|
||||
selectFirst [ZcashTransactionBlock >. 0] [Desc ZcashTransactionBlock]
|
||||
PS.runSqlite dbPath $
|
||||
selectOne $ do
|
||||
txs <- from $ table @ZcashTransaction
|
||||
where_ (txs ^. ZcashTransactionBlock >. val 0)
|
||||
orderBy [desc $ txs ^. ZcashTransactionBlock]
|
||||
pure txs
|
||||
case b of
|
||||
Nothing -> return $ -1
|
||||
Just x -> return $ zcashTransactionBlock $ entityVal x
|
||||
|
||||
-- | Returns the largest block in the wallet
|
||||
getMaxWalletBlock ::
|
||||
T.Text -- ^ The database path
|
||||
-> IO Int
|
||||
getMaxWalletBlock dbPath = do
|
||||
b <-
|
||||
runSqlite dbPath $
|
||||
selectFirst [WalletTransactionBlock >. 0] [Desc WalletTransactionBlock]
|
||||
case b of
|
||||
Nothing -> return $ -1
|
||||
Just x -> return $ walletTransactionBlock $ entityVal x
|
||||
|
||||
-- | Returns a list of addresses associated with the given account
|
||||
getAddresses ::
|
||||
T.Text -- ^ The database path
|
||||
-> ZcashAccountId -- ^ The account ID to check
|
||||
-> IO [Entity WalletAddress]
|
||||
getAddresses dbFp a =
|
||||
runSqlite dbFp $
|
||||
selectList
|
||||
[WalletAddressAccId ==. a, WalletAddressScope ==. ScopeDB External]
|
||||
[]
|
||||
PS.runSqlite dbFp $
|
||||
select $ do
|
||||
addrs <- from $ table @WalletAddress
|
||||
where_ (addrs ^. WalletAddressAccId ==. val a)
|
||||
where_ (addrs ^. WalletAddressScope ==. val (ScopeDB External))
|
||||
pure addrs
|
||||
|
||||
-- | Returns a list of addressess associated with the given wallet
|
||||
getWalletAddresses ::
|
||||
T.Text -- ^ The database path
|
||||
-> ZcashWalletId -- ^ the wallet to search
|
||||
-> IO [Entity WalletAddress]
|
||||
getWalletAddresses dbFp w = do
|
||||
accs <- getAccounts dbFp w
|
||||
addrs <- mapM (getAddresses dbFp . entityKey) accs
|
||||
return $ concat addrs
|
||||
|
||||
-- | Returns the largest address index for the given account
|
||||
getMaxAddress ::
|
||||
|
@ -240,10 +288,13 @@ getMaxAddress ::
|
|||
-> IO Int
|
||||
getMaxAddress dbFp aw s = do
|
||||
a <-
|
||||
runSqlite dbFp $
|
||||
selectFirst
|
||||
[WalletAddressAccId ==. aw, WalletAddressScope ==. ScopeDB s]
|
||||
[Desc WalletAddressIndex]
|
||||
PS.runSqlite dbFp $
|
||||
selectOne $ do
|
||||
addrs <- from $ table @WalletAddress
|
||||
where_ $ addrs ^. WalletAddressAccId ==. val aw
|
||||
where_ $ addrs ^. WalletAddressScope ==. val (ScopeDB s)
|
||||
orderBy [desc $ addrs ^. WalletAddressIndex]
|
||||
pure addrs
|
||||
case a of
|
||||
Nothing -> return $ -1
|
||||
Just x -> return $ walletAddressIndex $ entityVal x
|
||||
|
@ -253,7 +304,7 @@ saveAddress ::
|
|||
T.Text -- ^ the database path
|
||||
-> WalletAddress -- ^ The wallet to add to the database
|
||||
-> IO (Maybe (Entity WalletAddress))
|
||||
saveAddress dbFp w = runSqlite dbFp $ insertUniqueEntity w
|
||||
saveAddress dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w
|
||||
|
||||
-- | Save a transaction to the data model
|
||||
saveTransaction ::
|
||||
|
@ -262,30 +313,50 @@ saveTransaction ::
|
|||
-> Transaction -- ^ The transaction to save
|
||||
-> IO (Key ZcashTransaction)
|
||||
saveTransaction dbFp t wt =
|
||||
runSqlite dbFp $ do
|
||||
PS.runSqlite dbFp $ do
|
||||
let ix = [0 ..]
|
||||
w <-
|
||||
insert $
|
||||
ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t
|
||||
when (isJust $ tx_transpBundle wt) $
|
||||
insertMany_ $
|
||||
map (storeTxOut w) $ (tb_vout . fromJust . tx_transpBundle) wt
|
||||
when (isJust $ tx_transpBundle wt) $ do
|
||||
_ <-
|
||||
insertMany_ $
|
||||
zipWith (curry (storeTxOut w)) ix $
|
||||
(tb_vout . fromJust . tx_transpBundle) wt
|
||||
_ <-
|
||||
insertMany_ $
|
||||
zipWith (curry (storeTxIn w)) ix $
|
||||
(tb_vin . fromJust . tx_transpBundle) wt
|
||||
return ()
|
||||
when (isJust $ tx_saplingBundle wt) $ do
|
||||
_ <-
|
||||
insertMany_ $
|
||||
map (storeSapSpend w) $ (sbSpends . fromJust . tx_saplingBundle) wt
|
||||
zipWith (curry (storeSapSpend w)) ix $
|
||||
(sbSpends . fromJust . tx_saplingBundle) wt
|
||||
_ <-
|
||||
insertMany_ $
|
||||
map (storeSapOutput w) $ (sbOutputs . fromJust . tx_saplingBundle) wt
|
||||
zipWith (curry (storeSapOutput w)) ix $
|
||||
(sbOutputs . fromJust . tx_saplingBundle) wt
|
||||
return ()
|
||||
when (isJust $ tx_orchardBundle wt) $
|
||||
insertMany_ $
|
||||
map (storeOrchAction w) $ (obActions . fromJust . tx_orchardBundle) wt
|
||||
zipWith (curry (storeOrchAction w)) ix $
|
||||
(obActions . fromJust . tx_orchardBundle) wt
|
||||
return w
|
||||
where
|
||||
storeTxOut :: ZcashTransactionId -> TxOut -> TransparentNote
|
||||
storeTxOut wid (TxOut v s) = TransparentNote wid (fromIntegral v) s
|
||||
storeSapSpend :: ZcashTransactionId -> ShieldedSpend -> ShieldSpend
|
||||
storeSapSpend wid sp =
|
||||
storeTxOut :: ZcashTransactionId -> (Int, TxOut) -> TransparentNote
|
||||
storeTxOut wid (i, TxOut v s) = TransparentNote wid (fromIntegral v) s i
|
||||
storeTxIn :: ZcashTransactionId -> (Int, TxIn) -> TransparentSpend
|
||||
storeTxIn wid (i, TxIn (OutPoint h k) s sq) =
|
||||
TransparentSpend
|
||||
wid
|
||||
(HexStringDB . fromText $ txHashToHex h)
|
||||
(fromIntegral k)
|
||||
s
|
||||
(fromIntegral sq)
|
||||
i
|
||||
storeSapSpend :: ZcashTransactionId -> (Int, ShieldedSpend) -> ShieldSpend
|
||||
storeSapSpend wid (i, sp) =
|
||||
ShieldSpend
|
||||
wid
|
||||
(HexStringDB $ sp_cv sp)
|
||||
|
@ -294,8 +365,10 @@ saveTransaction dbFp t wt =
|
|||
(HexStringDB $ sp_rk sp)
|
||||
(HexStringDB $ sp_proof sp)
|
||||
(HexStringDB $ sp_auth sp)
|
||||
storeSapOutput :: ZcashTransactionId -> ShieldedOutput -> ShieldOutput
|
||||
storeSapOutput wid so =
|
||||
i
|
||||
storeSapOutput ::
|
||||
ZcashTransactionId -> (Int, ShieldedOutput) -> ShieldOutput
|
||||
storeSapOutput wid (i, so) =
|
||||
ShieldOutput
|
||||
wid
|
||||
(HexStringDB $ s_cv so)
|
||||
|
@ -304,8 +377,9 @@ saveTransaction dbFp t wt =
|
|||
(HexStringDB $ s_encCipherText so)
|
||||
(HexStringDB $ s_outCipherText so)
|
||||
(HexStringDB $ s_proof so)
|
||||
storeOrchAction :: ZcashTransactionId -> OrchardAction -> OrchAction
|
||||
storeOrchAction wid oa =
|
||||
i
|
||||
storeOrchAction :: ZcashTransactionId -> (Int, OrchardAction) -> OrchAction
|
||||
storeOrchAction wid (i, oa) =
|
||||
OrchAction
|
||||
wid
|
||||
(HexStringDB $ nf oa)
|
||||
|
@ -316,3 +390,91 @@ saveTransaction dbFp t wt =
|
|||
(HexStringDB $ out_ciphertext oa)
|
||||
(HexStringDB $ cv oa)
|
||||
(HexStringDB $ auth oa)
|
||||
i
|
||||
|
||||
-- | Get the transactions from a particular block forward
|
||||
getZcashTransactions ::
|
||||
T.Text -- ^ The database path
|
||||
-> Int -- ^ Block
|
||||
-> IO [Entity ZcashTransaction]
|
||||
getZcashTransactions dbFp b =
|
||||
PS.runSqlite dbFp $
|
||||
select $ do
|
||||
txs <- from $ table @ZcashTransaction
|
||||
where_ $ txs ^. ZcashTransactionBlock >. val b
|
||||
orderBy [asc $ txs ^. ZcashTransactionBlock]
|
||||
return txs
|
||||
|
||||
-- * Wallet
|
||||
-- | Get the block of the last transaction known to the wallet
|
||||
getMaxWalletBlock ::
|
||||
T.Text -- ^ The database path
|
||||
-> IO Int
|
||||
getMaxWalletBlock dbPath = do
|
||||
b <-
|
||||
PS.runSqlite dbPath $
|
||||
selectOne $ do
|
||||
txs <- from $ table @WalletTransaction
|
||||
where_ $ txs ^. WalletTransactionBlock >. val 0
|
||||
orderBy [desc $ txs ^. WalletTransactionBlock]
|
||||
return txs
|
||||
case b of
|
||||
Nothing -> return $ -1
|
||||
Just x -> return $ walletTransactionBlock $ entityVal x
|
||||
|
||||
-- | Find the Transparent Notes that match the given transparent receiver
|
||||
findTransparentNotes ::
|
||||
T.Text -- ^ The database path
|
||||
-> Int -- ^ Starting block
|
||||
-> WalletAddress
|
||||
-> IO [(Entity ZcashTransaction, Entity TransparentNote)]
|
||||
findTransparentNotes dbPath b t = do
|
||||
let tReceiver = t_rec =<< readUnifiedAddressDB t
|
||||
case tReceiver of
|
||||
Just tR -> do
|
||||
let s =
|
||||
BS.concat
|
||||
[ BS.pack [0x76, 0xA9, 0x14]
|
||||
, (toBytes . ta_bytes) tR
|
||||
, BS.pack [0x88, 0xAC]
|
||||
]
|
||||
PS.runSqlite dbPath $
|
||||
select $ do
|
||||
(txs :& tNotes) <-
|
||||
from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
|
||||
(\(txs :& tNotes) ->
|
||||
txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx)
|
||||
where_ (txs ^. ZcashTransactionBlock >. val b)
|
||||
where_ (tNotes ^. TransparentNoteScript ==. val s)
|
||||
pure (txs, tNotes)
|
||||
Nothing -> return []
|
||||
|
||||
-- | Add the transparent notes to the wallet
|
||||
saveWalletTrNote ::
|
||||
T.Text -- ^ the database path
|
||||
-> (Entity ZcashTransaction, Entity TransparentNote)
|
||||
-> WalletAddressId
|
||||
-> IO ()
|
||||
saveWalletTrNote dbPath (zt, tn) wa = do
|
||||
let zT' = entityVal zt
|
||||
PS.runSqlite dbPath $ do
|
||||
t <-
|
||||
upsert
|
||||
(WalletTransaction
|
||||
(zcashTransactionTxId zT')
|
||||
(zcashTransactionBlock zT')
|
||||
(zcashTransactionConf zT')
|
||||
(zcashTransactionTime zT'))
|
||||
[]
|
||||
insert_ $
|
||||
WalletTrNote
|
||||
(entityKey t)
|
||||
wa
|
||||
(transparentNoteValue $ entityVal tn)
|
||||
(entityKey tn)
|
||||
False
|
||||
|
||||
-- | Helper function to extract a Unified Address from the database
|
||||
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
||||
readUnifiedAddressDB =
|
||||
isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress
|
||||
|
|
11
test/Spec.hs
11
test/Spec.hs
|
@ -4,6 +4,7 @@ import Control.Monad (when)
|
|||
import Database.Persist
|
||||
import Database.Persist.Sqlite
|
||||
import System.Directory
|
||||
import Test.HUnit
|
||||
import Test.Hspec
|
||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||
import ZcashHaskell.Types
|
||||
|
@ -98,3 +99,13 @@ main = do
|
|||
let ua =
|
||||
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
|
||||
isValidUnifiedAddress ua `shouldNotBe` Nothing
|
||||
describe "Function tests" $ do
|
||||
it "Wallet sync" $ do
|
||||
w <-
|
||||
runSqlite "zenith.db" $
|
||||
selectFirst [ZcashWalletBirthdayHeight >. 0] []
|
||||
case w of
|
||||
Nothing -> assertFailure "No wallet in DB"
|
||||
Just w' -> do
|
||||
r <- syncWallet "zenith.db" w'
|
||||
r `shouldBe` "Done"
|
||||
|
|
|
@ -1 +1 @@
|
|||
Subproject commit 938ccb4b9730fd8615513eb27bdbffacd62e29cc
|
||||
Subproject commit 2709d422667080527ccc180e97352693a4c6c2c7
|
|
@ -39,10 +39,12 @@ library
|
|||
Clipboard
|
||||
, aeson
|
||||
, array
|
||||
, ascii-progress
|
||||
, base >=4.12 && <5
|
||||
, base64-bytestring
|
||||
, brick
|
||||
, bytestring
|
||||
, esqueleto
|
||||
, ghc
|
||||
, haskoin-core
|
||||
, hexstring
|
||||
|
@ -65,7 +67,6 @@ library
|
|||
, vector
|
||||
, vty
|
||||
, word-wrap
|
||||
, ascii-progress
|
||||
, zcash-haskell
|
||||
--pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
@ -119,6 +120,7 @@ test-suite zenith-tests
|
|||
, persistent
|
||||
, persistent-sqlite
|
||||
, hspec
|
||||
, HUnit
|
||||
, directory
|
||||
, zcash-haskell
|
||||
, zenith
|
||||
|
|
Loading…
Reference in a new issue