{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} 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 Database.Persist.TH import Haskoin.Transaction.Common (TxOut(..)) import ZcashHaskell.Types ( OrchardAction(..) , OrchardBundle(..) , SaplingBundle(..) , Scope(..) , ShieldedOutput(..) , ShieldedSpend(..) , Transaction(..) , TransparentBundle(..) , ZcashNet ) import Zenith.Types ( HexStringDB(..) , OrchardSpendingKeyDB(..) , PhraseDB(..) , SaplingSpendingKeyDB(..) , ScopeDB(..) , TransparentSpendingKeyDB , UnifiedAddressDB(..) , ZcashNetDB(..) ) share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| ZcashWallet name T.Text network ZcashNetDB seedPhrase PhraseDB birthdayHeight Int UniqueWallet name network deriving Show Eq ZcashAccount index Int walletId ZcashWalletId name T.Text orchSpendKey OrchardSpendingKeyDB sapSpendKey SaplingSpendingKeyDB tPrivateKey TransparentSpendingKeyDB UniqueAccount index walletId UniqueAccName walletId name deriving Show Eq WalletAddress index Int accId ZcashAccountId name T.Text uAddress UnifiedAddressDB scope ScopeDB UniqueAddress index scope accId UniqueAddName accId name deriving Show Eq |] share [mkPersist sqlSettings, mkMigrate "rawStorage"] [persistLowerCase| WalletTransaction block Int txId HexStringDB conf Int time Int deriving Show Eq TransparentNote tx WalletTransactionId value Int script BS.ByteString OrchAction tx WalletTransactionId nf HexStringDB rk HexStringDB cmx HexStringDB ephKey HexStringDB encCipher HexStringDB outCipher HexStringDB cv HexStringDB auth HexStringDB deriving Show Eq ShieldOutput tx WalletTransactionId cv HexStringDB cmu HexStringDB ephKey HexStringDB encCipher HexStringDB outCipher HexStringDB proof HexStringDB deriving Show Eq ShieldSpend tx WalletTransactionId cv HexStringDB anchor HexStringDB nullifier HexStringDB rk HexStringDB proof HexStringDB authSig HexStringDB deriving Show Eq |] -- * Database functions -- | Initializes the database initDb :: T.Text -- ^ The database path to check -> IO () initDb dbName = do runSqlite dbName $ do runMigration migrateAll -- | Initializes the raw data storage initRawStore :: T.Text -- ^ the database path -> IO () initRawStore dbFilePath = runSqlite dbFilePath $ runMigration rawStorage -- | Get existing wallets from database getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet] getWallets dbFp n = runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] [] -- | 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 -- | 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] [] -- | Returns the largest account index for the given wallet getMaxAccount :: T.Text -- ^ The database path -> ZcashWalletId -- ^ The wallet ID to check -> IO Int getMaxAccount dbFp w = do a <- runSqlite dbFp $ selectFirst [ZcashAccountWalletId ==. w] [Desc ZcashAccountIndex] case a of Nothing -> return $ -1 Just x -> return $ zcashAccountIndex $ entityVal x -- | Save a new account to the database 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 -- | 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] [] -- | Returns the largest address index for the given account getMaxAddress :: T.Text -- ^ The database path -> ZcashAccountId -- ^ The account ID to check -> Scope -- ^ The scope of the address -> IO Int getMaxAddress dbFp aw s = do a <- runSqlite dbFp $ selectFirst [WalletAddressAccId ==. aw, WalletAddressScope ==. ScopeDB s] [Desc WalletAddressIndex] case a of Nothing -> return $ -1 Just x -> return $ walletAddressIndex $ entityVal x -- | Save a new address to the database 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 -- | Save a transaction to the data model saveTransaction :: T.Text -- ^ the database path -> Int -- ^ block time -> Transaction -- ^ The transaction to save -> IO (Key WalletTransaction) saveTransaction dbFp t wt = runSqlite dbFp $ do w <- insert $ WalletTransaction (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_saplingBundle wt) $ do _ <- insertMany_ $ map (storeSapSpend w) $ (sbSpends . fromJust . tx_saplingBundle) wt _ <- insertMany_ $ map (storeSapOutput w) $ (sbOutputs . fromJust . tx_saplingBundle) wt return () when (isJust $ tx_orchardBundle wt) $ insertMany_ $ map (storeOrchAction w) $ (obActions . fromJust . tx_orchardBundle) wt return w where storeTxOut :: WalletTransactionId -> TxOut -> TransparentNote storeTxOut wid (TxOut v s) = TransparentNote wid (fromIntegral v) s storeSapSpend :: WalletTransactionId -> ShieldedSpend -> ShieldSpend storeSapSpend wid sp = ShieldSpend wid (HexStringDB $ sp_cv sp) (HexStringDB $ sp_anchor sp) (HexStringDB $ sp_nullifier sp) (HexStringDB $ sp_rk sp) (HexStringDB $ sp_proof sp) (HexStringDB $ sp_auth sp) storeSapOutput :: WalletTransactionId -> ShieldedOutput -> ShieldOutput storeSapOutput wid so = ShieldOutput wid (HexStringDB $ s_cv so) (HexStringDB $ s_cmu so) (HexStringDB $ s_ephKey so) (HexStringDB $ s_encCipherText so) (HexStringDB $ s_outCipherText so) (HexStringDB $ s_proof so) storeOrchAction :: WalletTransactionId -> OrchardAction -> OrchAction storeOrchAction wid oa = OrchAction wid (HexStringDB $ nf oa) (HexStringDB $ rk oa) (HexStringDB $ cmx oa) (HexStringDB $ eph_key oa) (HexStringDB $ enc_ciphertext oa) (HexStringDB $ out_ciphertext oa) (HexStringDB $ cv oa) (HexStringDB $ auth oa)