Migrate to Esqueleto

Reviewed-on: #74

src/Zenith/Core.hs

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

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) $
+    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

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"

zcash-haskell

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

zenith.cabal

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