Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 21 Pull requests Projects Releases 6 Packages Wiki Activity

Migrate to Esqueleto

Browse source
This commit is contained in:
Rene Vergara 2024-04-07 09:25:25 -05:00
parent a36de0a307
commit 5ce822e52f
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
5 changed files with 233 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
src/Zenith/Core.hs
View file

@ -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

258
src/Zenith/DB.hs
View file

@ -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) $
when (isJust $ tx_transpBundle wt) $ do
_ <-
insertMany_ $
map (storeTxOut w) $ (tb_vout . fromJust . tx_transpBundle) wt
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
View file

@ -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"

2
zcash-haskell

@ -1 +1 @@
Subproject commit 938ccb4b9730fd8615513eb27bdbffacd62e29cc
Subproject commit 2709d422667080527ccc180e97352693a4c6c2c7

4
zenith.cabal
View file

@ -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