Add new raw tx table
This commit is contained in:
parent
826ed5b697
commit
22f889bf86
2 changed files with 22 additions and 2 deletions
|
@ -1,6 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- Core wallet functionality for Zenith
|
||||
-- | Core wallet functionality for Zenith
|
||||
module Zenith.Core where
|
||||
|
||||
import Control.Exception (throwIO)
|
||||
|
|
|
@ -19,13 +19,15 @@ module Zenith.DB where
|
|||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.HexString
|
||||
import qualified Data.Text as T
|
||||
import Database.Persist
|
||||
import Database.Persist.Sqlite
|
||||
import Database.Persist.TH
|
||||
import ZcashHaskell.Types (Scope(..), ZcashNet)
|
||||
import Zenith.Types
|
||||
( OrchardSpendingKeyDB(..)
|
||||
( HexStringDB(..)
|
||||
, OrchardSpendingKeyDB(..)
|
||||
, PhraseDB(..)
|
||||
, SaplingSpendingKeyDB(..)
|
||||
, ScopeDB(..)
|
||||
|
@ -65,6 +67,18 @@ share
|
|||
deriving Show Eq
|
||||
|]
|
||||
|
||||
share
|
||||
[mkPersist sqlSettings, mkMigrate "rawStorage"]
|
||||
[persistLowerCase|
|
||||
WalletTransaction
|
||||
block Int
|
||||
txId HexStringDB
|
||||
conf Int
|
||||
time Int
|
||||
hex HexStringDB
|
||||
deriving Show Eq
|
||||
|]
|
||||
|
||||
-- * Database functions
|
||||
-- | Initializes the database
|
||||
initDb ::
|
||||
|
@ -73,6 +87,12 @@ initDb ::
|
|||
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 =
|
||||
|
|
Loading…
Reference in a new issue