Implement DB tests for wallet
This commit is contained in:
parent
9a7f191d1b
commit
b89ee243b7
4 changed files with 96 additions and 3 deletions
|
@ -41,7 +41,9 @@ library:
|
||||||
- array
|
- array
|
||||||
- base64-bytestring
|
- base64-bytestring
|
||||||
- hexstring
|
- hexstring
|
||||||
- blake2
|
- persistent
|
||||||
|
- persistent-sqlite
|
||||||
|
- persistent-template
|
||||||
- zcash-haskell
|
- zcash-haskell
|
||||||
|
|
||||||
executables:
|
executables:
|
||||||
|
@ -74,3 +76,7 @@ tests:
|
||||||
- -with-rtsopts=-N
|
- -with-rtsopts=-N
|
||||||
dependencies:
|
dependencies:
|
||||||
- zenith
|
- zenith
|
||||||
|
- hspec
|
||||||
|
- persistent
|
||||||
|
- persistent-sqlite
|
||||||
|
- persistent-template
|
||||||
|
|
|
@ -1 +1,35 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE EmptyDataDecls #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE GADTs #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
|
||||||
module Zenith.DB where
|
module Zenith.DB where
|
||||||
|
|
||||||
|
import qualified Data.ByteString as BS
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import Database.Persist
|
||||||
|
import Database.Persist.Sqlite
|
||||||
|
import Database.Persist.TH
|
||||||
|
import ZcashHaskell.Types (Phrase)
|
||||||
|
|
||||||
|
share
|
||||||
|
[mkPersist sqlSettings, mkMigrate "migrateAll"]
|
||||||
|
[persistLowerCase|
|
||||||
|
ZcashWallet
|
||||||
|
seedPhrase Phrase
|
||||||
|
spendingKey BS.ByteString
|
||||||
|
tPrivateKey BS.ByteString
|
||||||
|
birthdayHeight Int
|
||||||
|
name T.Text
|
||||||
|
deriving Show
|
||||||
|
|]
|
||||||
|
|
49
test/Spec.hs
49
test/Spec.hs
|
@ -1,2 +1,49 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import Database.Persist
|
||||||
|
import Database.Persist.Sqlite
|
||||||
|
import Test.Hspec
|
||||||
|
import Zenith.DB
|
||||||
|
import Zenith.DB
|
||||||
|
( EntityField(ZcashWalletId, ZcashWalletName)
|
||||||
|
, ZcashWallet(zcashWalletName)
|
||||||
|
)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = putStrLn "Test suite not yet implemented"
|
main = do
|
||||||
|
hspec $ do
|
||||||
|
describe "Database tests" $ do
|
||||||
|
it "Create table" $ do
|
||||||
|
s <- runSqlite "test.db" $ do runMigration migrateAll
|
||||||
|
s `shouldBe` ()
|
||||||
|
it "insert wallet record" $ do
|
||||||
|
s <-
|
||||||
|
runSqlite "test.db" $ do
|
||||||
|
insert $
|
||||||
|
ZcashWallet
|
||||||
|
"one two three four five six seven eight nine ten eleven twelve"
|
||||||
|
"123456789"
|
||||||
|
"987654321"
|
||||||
|
2000000
|
||||||
|
"Main Wallet"
|
||||||
|
fromSqlKey s `shouldBe` 1
|
||||||
|
it "read wallet record" $ do
|
||||||
|
s <-
|
||||||
|
runSqlite "test.db" $ do
|
||||||
|
selectList [ZcashWalletBirthdayHeight >. 0] []
|
||||||
|
length s `shouldBe` 1
|
||||||
|
it "modify wallet record" $ do
|
||||||
|
s <-
|
||||||
|
runSqlite "test.db" $ do
|
||||||
|
let recId = toSqlKey 1 :: ZcashWalletId
|
||||||
|
update recId [ZcashWalletName =. "New Wallet"]
|
||||||
|
get recId
|
||||||
|
"New Wallet" `shouldBe` maybe "None" zcashWalletName s
|
||||||
|
it "delete wallet record" $ do
|
||||||
|
s <-
|
||||||
|
runSqlite "test.db" $ do
|
||||||
|
let recId = toSqlKey 1 :: ZcashWalletId
|
||||||
|
delete recId
|
||||||
|
get recId
|
||||||
|
"None" `shouldBe` maybe "None" zcashWalletName s
|
||||||
|
|
|
@ -39,11 +39,13 @@ library
|
||||||
, array
|
, array
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, base64-bytestring
|
, base64-bytestring
|
||||||
, blake2
|
|
||||||
, bytestring
|
, bytestring
|
||||||
, hexstring
|
, hexstring
|
||||||
, http-conduit
|
, http-conduit
|
||||||
, http-types
|
, http-types
|
||||||
|
, persistent
|
||||||
|
, persistent-sqlite
|
||||||
|
, persistent-template
|
||||||
, process
|
, process
|
||||||
, regex-base
|
, regex-base
|
||||||
, regex-compat
|
, regex-compat
|
||||||
|
@ -83,5 +85,9 @@ test-suite zenith-test
|
||||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.7 && <5
|
base >=4.7 && <5
|
||||||
|
, hspec
|
||||||
|
, persistent
|
||||||
|
, persistent-sqlite
|
||||||
|
, persistent-template
|
||||||
, zenith
|
, zenith
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
Loading…
Reference in a new issue